diff options
Diffstat (limited to 'gcc/fortran')
80 files changed, 27505 insertions, 12539 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 335ca6b956..b5cb787b6b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,725 +1,569 @@ -2016-08-22 Release Manager +2017-05-02 Release Manager - * GCC 6.2.0 released. + * GCC 7.1.0 released. -2016-08-16 Thomas Koenig <tkoenig@gcc.gnu.org> +2017-04-17 Paul Thomas <pault@gcc.gnu.org> - Backport from trunk - * frontend-passes.c (create_var): Set ts.deferred for - deferred-length character variables. - * dump-parse-tree.c (show_typespec): Also dump - is_c_interop, is_iso_c and deferred flags. + PR fortran/80440 + * module.c (find_symtree_for_symbol): Delete. + (read_module): Remove the call to the above. -2016-08-15 Jakub Jelinek <jakub@redhat.com> +2017-04-14 Janus Weil <janus@gcc.gnu.org> - PR debug/71906 - * trans-decl.c (gfc_get_symbol_decl): Call gfc_finish_var_decl - for decl's character length before gfc_finish_var_decl on the - decl itself. + PR fortran/80361 + * class.c (generate_finalization_wrapper): Give the finalization wrapper + the recursive attribute. -2016-08-11 Andre Vehreschild <vehre@gcc.gnu.org> +2017-04-10 Nicolas Koenig <koenigni@student.ethz.ch> + Paul Thomas <pault@gcc.gnu.org> - Backport from trunk: - PR fortran/71936 - * trans-array.c (gfc_array_allocate): When SOURCE= is a function - stick with the ref of the object to allocate. + PR fortran/69498 + * module.c (gfc_match_submodule): Add error + if function is called in the wrong state. -2016-08-11 Andre Vehreschild <vehre@gcc.gnu.org> +2017-04-10 Janus Weil <janus@gcc.gnu.org> - Backport from trunk - PR fortran/72698 - * trans-stmt.c (gfc_trans_allocate): Prevent generating code for - copy of zero sized string and with it an ICE. + PR fortran/80046 + * expr.c (gfc_check_pointer_assign): Check if procedure pointer + components in a pointer assignment need an explicit interface. -2016-08-08 Andre Vehreschild <vehre@gcc.gnu.org> +2017-03-18 Nicolas Koenig <koenigni@student.ethz.ch> - Backport from trunk: - PR fortran/70524 - * trans-array.c (gfc_trans_dummy_array_bias): Ensure that the - location information is correctly set. - * trans-decl.c (gfc_trans_deferred_vars): Set the locus of the - current construct early. + PR fortran/69498 + * symbol.c (gfc_delete_symtree): If there is a period in the name, ignore + everything before it. -2016-08-07 Thomas Koenig <tkoenig@gcc.gnu.org> +2017-03-28 Janus Weil <janus@gcc.gnu.org> - PR fortran/71795 - Backport from trunk - * frontend-passes.c (combine_array_constructor): Don't - do anything if the expression is inside an array iterator. + PR fortran/78661 + * trans-io.c (transfer_namelist_element): Perform a polymorphic call + to a DTIO procedure if necessary. -2016-07-28 Steven G. Kargl <kargl@gcc.gnu.org> - Thomas Koenig <tkoenig@gcc.gnu.org> +2017-03-25 Paul Thomas <pault@gcc.gnu.org> - Backported from trunk: - PR fortran/71883 - * frontend-passes.c (gfc_run_passes): Bail out if there are any - errors. - * error.c (gfc_internal_error): If there are any errors in the - buffer, exit with EXIT_FAILURE. + PR fortran/80156 + PR fortran/79382 + * decl.c (access_attr_decl): Remove the error for an absent + generic DTIO interface and ensure that symbol has the flavor + FL_PROCEDURE. -2016-07-22 Andre Vehreschild <vehre@gcc.gnu.org> +2017-03-22 Dominique d'Humieres <dominiq@lps.ens.fr> - Backported from trunk: - PR fortran/71807 - * trans-expr.c (gfc_trans_subcomponent_assign): Special casing - when allocatable component is set to null() in initializer. + PR fortran/79838 + * module.c: Remove trailing period. -2016-07-22 Andre Vehreschild <vehre@gcc.gnu.org> +2017-03-22 Dominique d'Humieres <dominiq@lps.ens.fr> - Backport from trunk: - PR fortran/70842 - * simplify.c (gfc_simplify_len): Only for unlimited polymorphic - types replace the expression's _data ref with a _len ref. + PR fortran/79602 + * decl.c: Replace '%s' with %qs. + * expr.c: Likewise. + * interface.c: Likewise. + * match.c: Likewise. + * primary.c: Likewise. + * resolve.c: Likewise. -2016-07-15 Jerry DeLisle <jvdelisle@gcc.gnu.org> + PR fortran/79844 + PR fortran/80011 + * io.c: Remove trailing spaces. + * match.c: Likewise. + * openmp.c: Likewise. + * resolve.c: Likewise. + * trans-intrinsic.c: Likewise. - Backport from trunk: - PR fortran/71764 - * trans-expr.c (gfc_trans_structure_assign): Remove assert. + PR fortran/79853 + * expr.c: Remove a double spaces. -2016-07-13 Andre Vehreschild <vehre@gcc.gnu.org> + PR fortran/79859 + * primary.c: Remove spurious quotes around %qs. + +2017-03-22 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/80142 + * frontend-passes.c (combine_array_constructor): Take + location of new expression from constructor expression instead + of constructor. + +2017-03-20 Nicolas Koenig <koenigni@student.ethz.ch> + + PR fortran/39239 + * symbol.c (check_conflict): Report an error if an EQUIVALENCE + object is BIND(C) + +2017-03-18 Nicolas Koenig <koenigni@student.ethz.ch> + + PR fortran/69498 + * decl.c (add_hidden_procptr_result): Fixed Refs count of the + created "ppr@" symbol. + +2017-03-18 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/79676 + * module.c (mio_symbol_attribute): Remove reset of the flag + 'no_module_procedures'. + (check_for_module_procedures): New function. Move declaration + of 'no_module_procedures' to above it. + (gfc_dump_module): Traverse namespace calling new function. + +2017-03-18 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/71838 + * symbol.c (check_conflict): A dummy procedure in a submodule, + module procedure is not an error. + (gfc_add_flavor): Ditto. + +2017-03-17 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/79841 + * openmp.c (check_symbol_not_pointer): Adjust diagnostics. + +2017-03-16 Jakub Jelinek <jakub@redhat.com> + + PR fortran/80010 + * parse.c (gfc_ascii_statement): Use !$ACC for ST_OACC_ATOMIC + and ST_OACC_END_ATOMIC, instead of !ACC. + * trans-decl.c (finish_oacc_declare): Use !$ACC instead of $!ACC. + * openmp.c (gfc_match_oacc_declare, gfc_match_oacc_wait, + gfc_resolve_oacc_declare): Likewise. + + PR fortran/79886 + * error.c (gfc_format_decoder): Rename plus argument to set_locus, + remove ATTRIBUTE_UNUSED from all arguments, call default_tree_printer + if not a Fortran specific spec. + * trans-io.c: Include options.h. + (gfc_build_st_parameter): Temporarily disable -Wpadded around layout + of artificial IO data structures. + +2017-03-15 David Malcolm <dmalcolm@redhat.com> + + PR fortran/79860 + * resolve.c (resolve_contained_fntype): Make error messages more + amenable to translation. + +2017-03-06 Richard Biener <rguenther@suse.de> + + PR fortran/79894 + * trans.c (gfc_add_modify_loc): Weaken assert. + +2017-03-05 Andre Vehreschild <vehre@gcc.gnu.org>, + Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> + + * check.c (positive_check): Add new function checking constant for + being greater then zero. + (gfc_check_image_status): Add checking of image_status arguments. + (gfc_check_failed_or_stopped_images): Same but for failed_- and + stopped_images function. + * dump-parse-tree.c (show_code_node): Added output of FAIL IMAGE. + * gfortran.h (enum gfc_statement): Added FAIL_IMAGE_ST. + (enum gfc_isym_id): Added new intrinsic symbols. + (enum gfc_exec_op): Added EXEC_FAIL_IMAGE. + * gfortran.texi: Added description for the new API functions. Updated + coverage of gfortran of TS18508. + * intrinsic.c (add_functions): Added symbols to resolve new intrinsic + functions. + * intrinsic.h: Added prototypes. + * iresolve.c (gfc_resolve_failed_images): Resolve the failed_images + intrinsic. + (gfc_resolve_image_status): Same for image_status. + (gfc_resolve_stopped_images): Same for stopped_images. + * libgfortran.h: Added prototypes. + * match.c (gfc_match_if): Added matching of FAIL IMAGE statement. + (gfc_match_fail_image): Match a FAIL IMAGE statement. + * match.h: Added prototype. + * parse.c (decode_statement): Added matching for FAIL IMAGE. + (next_statement): Same. + (gfc_ascii_statement): Same. + * resolve.c: Same. + * simplify.c (gfc_simplify_failed_or_stopped_images): For COARRAY= + single a constant result can be returne.d + (gfc_simplify_image_status): For COARRAY=single the result is constant. + * st.c (gfc_free_statement): Added FAIL_IMAGE handling. + * trans-decl.c (gfc_build_builtin_function_decls): Added decls of the + new intrinsics. + * trans-expr.c (gfc_conv_procedure_call): This is first time all + arguments of a function are optional, which is now handled here + correctly. + * trans-intrinsic.c (conv_intrinsic_image_status): Translate + image_status. + (gfc_conv_intrinsic_function): Add support for image_status. + (gfc_is_intrinsic_libcall): Add support for the remaining new + intrinsics. + * trans-stmt.c (gfc_trans_fail_image): Trans a fail image. + * trans-stmt.h: Add the prototype for the above. + * trans.c (trans_code): Dispatch for fail_image. + * trans.h: Add the trees for the new intrinsics. + +2017-03-03 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/79841 + * openmp.c (check_symbol_not_pointer): Adjust diagnostic. + +2017-02-28 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/79739 + * resolve.c (resolve_fl_procedure): Deal with the case where + 'submodule_name' is NULL so that gfc_error does not ICE. + Reformat the error message to make it more consistent. + +2017-02-28 Jakub Jelinek <jakub@redhat.com> + + * parse.c (parse_critical_block): Use cond ? G_("...") : G_("...") + instead of just cond ? "..." : "...". + * scanner.c (gfc_next_char_literal): Likewise. + * match.c (match_exit_cycle): Likewise. + +2017-02-26 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/51119 + * options.c (gfc_post_options): Set default limit for matmul + inlining to 30. + * invoke.texi: Document change. + +2017-02-25 Dominique d'Humieres <dominiq@lps.ens.fr> + + PR fortran/79601 + * interface.c (check_dtio_arg_TKR_intent): Change 'intent' + to 'INTENT'. + +2017-02-25 Dominique d'Humieres <dominiq@lps.ens.fr> + + PR fortran/79597 + * interface.c (gfc_match_end_interface): Remove spurious comma + and space, replace 'got %s' with 'got %qs'. + +2017-02-20 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/79599 + * interface.c (check_dtio_arg_TKR_intent): Supply 'must' + missing from error message. + +2017-02-20 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/79523 + * interface.c (gfc_find_typebound_dtio_proc): Guard test for + flavor attribute by checking that symbol is resolved. + +2017-02-16 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/79382 + * decl.c (access_attr_decl): Test for presence of generic DTIO + interface and emit error if not present. + +2017-02-20 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/79434 + * parse.c (check_component, parse_union): Whitespace. + (set_syms_host_assoc): For a derived type, check if the module + in which it was declared is one of the submodule ancestors. If + it is, make the components public. Otherwise, reset attribute + 'host_assoc' and set 'use-assoc' so that encapsulation is + preserved. - Backport from trunk: - PR fortran/71623 - * trans-stmt.c (gfc_trans_allocate): Add code of pre block of typespec - in allocate to parent block. +2017-02-19 Paul Thomas <pault@gcc.gnu.org> -2016-07-09 Thomas Koenig <tkoenig@gcc.gnu.org> + PR fortran/79447 + * decl.c (gfc_set_constant_character_len): Whitespace. + (gfc_match_end): Catch case where a procedure is contained in + a module procedure and ensure that 'end procedure' is the + correct termination. - Backport from trunk: - PR fortran/71783 - * frontend-passes.c (create_var): Always allocate a charlen - for character variables. +2017-02-19 Paul Thomas <pault@gcc.gnu.org> -2016-07-08 Cesar Philippidis <cesar@codesourcery.com> + PR fortran/79402 + * resolve.c (fixup_unique_dummy): New function. + (gfc_resolve_expr): Call it for dummy variables with a unique + symtree name. - Backport from trunk: - 2016-07-08 Cesar Philippidis <cesar@codesourcery.com> +2017-02-19 Andre Vehreschild <vehre@gcc.gnu.org> - * parse.c (matcha): Define. - (decode_oacc_directive): Add spec_only local var and set it. Use - matcha to parse acc directives except for routine and declare. Return - ST_GET_FCN_CHARACTERISTICS if a non-declarative directive could be - matched. + PR fortran/79229 + * trans-expr.c (gfc_trans_assignment_1): Deref indirect refs when + compiling with -fcheck=mem to check the pointer and not the data. -2016-07-02 Jakub Jelinek <jakub@redhat.com> +2017-02-19 Andre Vehreschild <vehre@gcc.gnu.org> - Backported from mainline - 2016-07-01 Jakub Jelinek <jakub@redhat.com> + PR fortran/79335 + * trans-array.c (duplicate_allocatable_coarray): Ensure attributes + passed are properly initialized. + (structure_alloc_comps): Same. + * trans-expr.c (gfc_trans_structure_assign): Same. - PR fortran/71687 - * f95-lang.c (struct binding_level): Add reversed field. - (clear_binding_level): Adjust initializer. - (getdecls): If reversed is clear, set it and nreverse the names - chain before returning it. - (poplevel): Use getdecls. - * trans-decl.c (gfc_generate_function_code, gfc_process_block_locals): - Use nreverse to pushdecl decls in the declaration order. +2017-02-13 Jakub Jelinek <jakub@redhat.com> - PR fortran/71717 - * trans-openmp.c (gfc_omp_privatize_by_reference): Return false - for GFC_DECL_ASSOCIATE_VAR_P with POINTER_TYPE. + * trans-expr.c (gfc_conv_substring): Add missing space in diagnostics. - 2016-06-30 Jakub Jelinek <jakub@redhat.com> +2017-02-12 Thomas Koenig <tkoenig@gcc.gnu.org> - PR fortran/71704 - * parse.c (matchs, matcho): Move right before decode_omp_directive. - If spec_only, only gfc_match the keyword and if successful, goto - do_spec_only. - (matchds, matchdo): Define. - (decode_omp_directive): Add spec_only local var and set it. - Use matchds or matchdo macros instead of matchs or matcho - for declare target, declare simd, declare reduction and threadprivate - directives. Return ST_GET_FCN_CHARACTERISTICS if a non-declarative - directive could be matched. - (next_statement): For ST_GET_FCN_CHARACTERISTICS restore - gfc_current_locus from old_locus even if there is no label. - - PR fortran/71705 - * trans-openmp.c (gfc_trans_omp_clauses): Set TREE_ADDRESSABLE on - decls in to/from clauses. - -2016-06-29 Cesar Philippidis <cesar@codesourcery.com> - - Back port from trunk - 2016-06-29 Cesar Philippidis <cesar@codesourcery.com> - - * openmp.c (match_oacc_clause_gang): Rename to ... - (match_oacc_clause_gwv): this. Add support for OpenACC worker and - vector clauses. - (gfc_match_omp_clauses): Use match_oacc_clause_gwv for - OMP_CLAUSE_{GANG,WORKER,VECTOR}. Propagate any MATCH_ERRORs for - invalid OMP_CLAUSE_{ASYNC,WAIT,GANG,WORKER,VECTOR} clauses. - (gfc_match_oacc_wait): Propagate MATCH_ERROR for invalid - oacc_expr_lists. Adjust the first and needs_space arguments to - gfc_match_omp_clauses. - -2016-06-27 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/70673 - * frontend-passes.c (realloc_string_callback): Add a call to - gfc_dep_compare_expr. - -2016-06-12 Dominique d'Humieres <dominiq@lps.ens.fr> - - PR fortran/60751 - * io.c (gfc_resolve_dt): Replace GFC_STD_GNU with GFC_STD_LEGACY. - -2016-06-10 Thomas Schwinge <thomas@codesourcery.com> - - PR c/71381 - Backport from trunk r237290: - * openmp.c (gfc_match_oacc_cache): Add comment. - -2016-06-05 Andre Vehreschild <vehre@gcc.gnu.org> - - PR fortran/69659 - * trans-array.c (gfc_trans_dummy_array_bias): For class arrays use - the address of the _data component to reference the arrays data - component. - -2016-06-01 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/71156 - * decl.c (copy_prefix): Add checks that the module procedure - declaration prefixes are compliant with the interface. Invert - order of existing elemental and pure checks. - * resolve.c (resolve_fl_procedure): Invert order of elemental - and pure errors. - -2016-06-01 Jakub Jelinek <jakub@redhat.com> - - * parse.c (case_decl): Move ST_OMP_* to ... - (case_omp_decl): ... here, new macro. - (verify_st_order): For case_omp_decl, complain about - p->state >= ORDER_EXEC, but don't change p->state otherwise. - -2016-05-26 Jerry DeLisle <jvdelisle@gcc.gnu.org> - - Backport from trunk. - PR fortran/66461 - * scanner.c (gfc_next_char_literal): Clear end_flag when adjusting - current locus back to old_locus. - -2016-05-20 Jakub Jelinek <jakub@redhat.com> - - PR fortran/71204 - * frontend-passes.c (realloc_string_callback): Clear inserted_block - and changed_statement before calling create_var. - -2016-05-15 Harald Anlauf <anlauf@gmx.de> - - PR fortran/69603 - * interface.c (compare_parameter): Check for non-NULL pointer. - -2016-05-14 Fritz Reese <fritzoreese@gmail.com> - - Backport from trunk: r236242 - * gfortran.texi: Update example of DEC UNION extension. - - Backport from trunk: r236241 - PR fortran/71047 - * expr.c (gfc_default_initializer): Avoid extra component refs in - constructors for derived types and classes. - - Backport from trunk: r235999 - PR fortran/56226 - * module.c (dt_upper_string): Rename to gfc_dt_upper_string - (dt_lower_string): Likewise. - * gfortran.h: Make new gfc_dt_upper/lower_string global. - * class.c: Use gfc_dt_upper_string. - * decl.c: Likewise. - * symbol.c: Likewise. - * resolve.c (resolve_component): New function. - (resolve_fl_derived0): Move component loop code to resolve_component. - * parse.c (check_component): New function. - (parse_derived): Move loop code to check_component. - * lang.opt, invoke.texi, options.c : New option -fdec-structure. - * libgfortran.h (bt): New basic type BT_UNION. - * gfortran.h (gfc_option): New option -fdec-structure. - (gfc_get_union_type, gfc_compare_union_types): New prototypes. - (gfc_bt_struct, gfc_fl_struct, case_bt_struct, case_fl_struct): New - macros. - (gfc_find_component): Change prototype. - * match.h (gfc_match_member_sep, gfc_match_map, gfc_match_union, - gfc_match_structure_decl): New prototypes. - * parse.h (gfc_comp_struct): New macro. - * symbol.c (gfc_find_component): Search for components in nested unions - * class.c (insert_component_ref, gfc_add_component_ref, add_proc_comp, - copy_vtab_proc_comps): Update calls to gfc_find_component. - * primary.c (gfc_convert_to_structure_constructor): Likewise. - * symbol.c (gfc_add_component): Likewise. - * resolve.c (resolve_typebound_function, resolve_typebound_subroutine, - resolve_typebound_procedure, resolve_component, resolve_fl_derived): - Likewise. - * expr.c (get_union_init, component_init): New functions. - * decl.c (match_clist_expr, match_record_decl, get_struct_decl, - gfc_match_map, gfc_match_union, gfc_match_structure_decl): Likewise. - * interface.c (compare_components, gfc_compare_union_types): Likewise. - * match.c (gfc_match_member_sep): Likewise. - * parse.c (check_component, parse_union, parse_struct_map): Likewise. - * resolve.c (resolve_fl_struct): Likewise. - * symbol.c (find_union_component): Likewise. - * trans-types.c (gfc_get_union_type): Likewise. - * parse.c (parse_derived): Use new functions. - * interface.c (gfc_compare_derived_types, gfc_compare_types): Likewise. - * expr.c (gfc_default_initializer): Likewise. - * gfortran.texi: Support for DEC structures, unions, and maps. - * gfortran.h (gfc_statement, sym_flavor): Likewise. - * check.c (gfc_check_kill_sub): Likewise. - * expr.c (gfc_copy_expr, simplify_const_ref, - gfc_has_default_initializer): Likewise. - * decl.c (build_sym, match_data_constant, add_init_expr_to_sym, - match_pointer_init, build_struct, variable_decl, - gfc_match_decl_type_spec, gfc_mach_data-decl, gfc_match_entry, - gfc_match_end, gfc_match_derived_decl): Likewise. - * interface.c (check_interface0, check_interface1, - gfc_search_interface): Likewise. - * misc.c (gfc_basic_typename, gfc_typename): Likewise. - * module.c (add_true_name, build_tnt, bt_types, mio_typespec, - fix_mio_expr, load_needed, mio_symbol, read_module, write_symbol, - gfc_get_module_backend_decl): Likewise. - * parse.h (gfc_compile_state): Likewise. - * parse.c (decode_specification_statement, decode_statement, - gfc_ascii_statement, verify_st_order, parse_spec): Likewise. - * primary.c (gfc_match_varspec, gfc_match_structure_constructor, - gfc_match_rvalue, match_variable): Likewise. - * resolve.c (find_arglists, resolve_structure_cons, - is_illegal_recursion, resolve_generic_f, get_declared_from_expr, - resolve_typebound_subroutine, resolve_allocate_expr, - nonscalar_typebound_assign, generate_component_assignments, - resolve_fl_variable_derived, check_defined_assignments, - resolve_component, resolve_symbol, resolve_equivalence_derived): - Likewise. - * symbol.c (flavors, check_conflict, gfc_add_flavor, gfc_use_derived, - gfc_restore_last_undo_checkpoint, gfc_type_compatible, - gfc_find_dt_in_generic): Likewise. - * trans-decl.c (gfc_get_module_backend_decl, create_function_arglist, - gfc_create_module_variable, check_constant_initializer): Likewise. - * trans-expr.c (gfc_conv_component_ref, gfc_conv_initializer, - gfc_trans_alloc_subarray_assign, gfc_trans_subcomponent_assign, - gfc_conv_structure, gfc_trans_scalar_assign, copyable_array_p): - Likewise. - * trans-io.c (transfer_namelist_element, transfer_expr, - gfc_trans_transfer): Likewise. - * trans-stmt.c (gfc_trans_deallocate): Likewise. - * trans-types.c (gfc_typenode_for_spec, gfc_copy_dt_decls_ifequal, - gfc_get_derived_type): Likewise. - -2016-05-11 Jakub Jelinek <jakub@redhat.com> - - PR fortran/70855 - * frontend-passes.c (inline_matmul_assign): Disable in !$omp workshare. - -2016-04-29 Cesar Philippidis <cesar@codesourcery.com> - - PR middle-end/70626 - * trans-openmp.c (gfc_trans_oacc_combined_directive): Duplicate - the reduction clause in both parallel and loop directives. - -2016-04-27 Release Manager - - * GCC 6.1.0 released. - -2016-04-13 Dominique d'Humieres <dominiq@lps.ens.fr> - - PR fortran/67039 - * intrinsic.texi: Correct the documentation of pseudorandom - number intrinsics. - -2016-04-13 Dominique d'Humieres <dominiq@lps.ens.fr> - - PR fortran/58000 - * gfortran.texi: Document OPEN( ... NAME=) as not implemented - in GNU Fortran - -2016-04-09 Jerry DeLisle <jvdelisle@gcc.gnu.org> - - PR fortran/68566 - * array.c (match_array_element_spec): Add check for non-integer. - * simplify.c (gfc_simplify_reshape): If source shape is NULL return. - -2016-04-06 Patrick Palka <ppalka@gcc.gnu.org> - - PR c/70436 - * openmp.c (gfc_find_omp_udr): Add explicit braces to resolve a - future -Wparentheses warning. - -2016-04-04 Andre Vehreschild <vehre@gcc.gnu.org> - - PR fortran/67538 - * resolve.c (resolve_allocate_expr): Emit error message when no - array spec and no array valued source= expression is given in an - F2008 allocate() for an array to allocate. - -2016-04-04 Andre Vehreschild <vehre@gcc.gnu.org> - - PR fortran/65795 - * trans-array.c (gfc_array_allocate): When the array is a coarray, - do not nullyfing its allocatable components in array_allocate, because - the nullify missed the array ref and nullifies the wrong component. - Cosmetics. - -2016-03-29 Andre Vehreschild <vehre@gcc.gnu.org> - - PR fortran/70397 - * trans-expr.c (gfc_class_len_or_zero_get): Add function to return a - constant zero tree, when the class to get the _len component from is - not unlimited polymorphic. - (gfc_copy_class_to_class): Use the new function. - * trans.h: Added interface of new function gfc_class_len_or_zero_get. - -2016-03-28 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> - - * trans-decl.c (gfc_build_builtin_function_decls): - caf_stop_numeric and caf_stop_str definition. - * trans-stmt.c (gfc_trans_stop): invoke external functions - for stop and stop_str when coarrays are used. - * trans.h: extern for new functions. - -2016-03-19 Jerry DeLisle <jvdelisle@gcc.gnu.org> - - PR fortran/69043 - * scanner.c (load_file): Update to use S_ISREG macro. + PR fortran/65542 + * intrinsic.c (gfc_intrinsic_func_interface): Return an error + for -std=f95 for disallowed transformational functions in + initialization expressions. -2016-03-17 Thomas Schwinge <thomas@codesourcery.com> +2017-02-09 Cesar Philippidis <cesar@codesourcery.com> + Joseph Myers <joseph@codesourcery.com> - * gfortran.h (enum gfc_omp_map_op): Rename OMP_MAP_FORCE_DEALLOC - to OMP_MAP_DELETE. Adjust all users. - -2016-03-13 Jerry DeLisle <jvdelisle@gcc.gnu.org> - Jim MacArthur <jim.macarthur@codethink.co.uk> - - PR fortran/69043 - * scanner.c (load_file): Check that included file is regular. - -2016-03-12 Jerry DeLisle <jvdelisle@gcc.gnu.org> - Harold Anlauf <anlauf@gmx.de> - - PR fortran/69520 - * invoke.texi: Explain use of the 'no-' construct within the - -fcheck= option. - * options.c (gfc_handle_runtime_check_option): Enable use of - 'no-' prefix for the various options with -fcheck= to allow - negating previously enabled check options. - -2016-03-12 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/70031 - * decl.c (gfc_match_prefix): Treat the 'module' prefix in the - same way as the others, rather than fixing it to come last. - (gfc_match_function_decl, gfc_match_subroutine): After errors - in 'copy_prefix', emit them immediately in the case of module - procedures to prevent a later ICE. - - PR fortran/69524 - * decl.c (gfc_match_submod_proc): Permit 'module procedure' - declarations within the contains section of modules as well as - submodules. - * resolve.c (resolve_fl_procedure): Likewise. - *trans-decl.c (build_function_decl): Change the gcc_assert to - allow all forms of module procedure declarations within module - contains sections. - -2016-02-28 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/68147 - PR fortran/47674 - * frontend-passes.c (realloc_string_callback): Don't set - walk_subtrees. - -2016-02-28 Thomas Koenig <tkoenig@gcc.gnu.org> - - * dump-parse-tree.c (show_code_node): Print association - list of a block if present. Handle EXEC_END_BLOCK. - -2016-02-28 Harald Anlauf <anlauf@gmx.de> - Jerry DeLisle <jvdelisle@gcc.gnu.org> - - PR fortran/56007 - * match.c (gfc_match_iterator): Add diagnostic for array variable - as do loop index. - -2016-02-27 Jerry DeLisle <jvdelisle@gcc.gnu.org> - Steven G. Kargl <kargl@gcc.gnu.org> - - PR fortran/69910 - * io.c (gfc_match_open): Check that open status is an expression - constant before comparing string to 'scratch' with NEWUNIT. - -2016-02-27 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> - - * trans.c (gfc_allocate_allocatable): size conversion - from byte to number of elements for event variables. - * trans-types.c (gfc_get_derived_type): event variables - represented as a pointer (like lock variable). - -2016-02-23 Jerry DeLisle <jvdelisle@gcc.gnu.org> - - PR fortran/61156 - * scanner.c (add_path_to_list): If include path is not a directory, - issue a fatal error. - -2016-02-23 Andre Vehreschild <vehre@gcc.gnu.org> - - PR fortran/67451 - * trans-array.c (gfc_array_allocate): Take the attributes from the - expression to allocate and not from the source=-expression. - -2016-02-20 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/69423 - * trans-decl.c (create_function_arglist): Deferred character - length functions, with and without declared results, address - the passed reference type as '.result' and the local string - length as '..result'. - (gfc_null_and_pass_deferred_len): Helper function to null and - return deferred string lengths, as needed. - (gfc_trans_deferred_vars): Call it, thereby reducing repeated - code, add call for deferred arrays and reroute pointer function - results. Avoid using 'tmp' for anything other that a temporary - tree by introducing 'type_of_array' for the arrayspec type. - -2015-02-16 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/69742 - * frontend-passes.c (cfe-expr_0): Don't register functions - from within an ASSOCIATE statement. - -2016-02-14 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/60526 - * decl.c (build_sym): If the name has already been defined as a - type, it has a symtree with an upper case letter at the beginning. - If such a symtree exists, issue an error and exit. Don't do - this if there is no corresponding upper case letter. - -2016-02-14 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/60526 - PR bootstrap/69816 - * decl.c (build_sym): Reverted previous patch. - -2016-02-14 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/60526 - * decl.c (build_sym): If the name has already been defined as a - type, issue error and return false. - -2016-02-12 David Malcolm <dmalcolm@redhat.com> - - PR other/69554 - * error.c (gfc_diagnostic_start_span): New function. - (gfc_diagnostics_init): Initialize global_dc's start_span. - -2016-02-11 Andre Vehreschild <vehre@gcc.gnu.org> - - PR fortran/69296 - * gfortran.h: Added flag to gfc_association_list indicating that - the rank of an associate variable has been guessed only. - * parse.c (parse_associate): Set the guess flag mentioned above - when guessing the rank of an expression. - * resolve.c (resolve_assoc_var): When the rank has been guessed, - make sure, that the guess was correct else overwrite with the actual - rank. - * trans-stmt.c (trans_associate_var): For subref_array_pointers in - class objects, take the span from the _data component. - -2016-02-07 Jerry DeLisle <jvdelisle@gcc.gnu.org> - - PR fortran/50555 - * primary.c (match_actual_arg): If symbol has attribute flavor of - namelist, generate an error. (gfc_match_rvalue): Likewise return - MATCH_ERROR. - * resolve.c (resolve_symbol): Scan arument list of procedures and - generate an error if a namelist is found. - -2016-02-05 Mikael Morin <mikael@gcc.gnu.org> - - PR fortran/66089 - * trans-expr.c (expr_is_variable, gfc_expr_is_variable): Rename - the former to the latter and make it non-static. Update callers. - * gfortran.h (gfc_expr_is_variable): New declaration. - (struct gfc_ss_info): Add field needs_temporary. - * trans-array.c (gfc_scalar_elemental_arg_saved_as_argument): - Tighten the condition on aggregate expressions with a check - that the expression is a variable and doesn't need a temporary. - (gfc_conv_resolve_dependency): Add intermediary reference variable. - Set the needs_temporary field. - -2016-02-03 Andre Vehreschild <vehre@gcc.gnu.org> - - PR fortran/67451 - PR fortran/69418 - * trans-expr.c (gfc_copy_class_to_class): For coarrays just the - pointer is passed. Take it as is without trying to deref the - _data component. - * trans-stmt.c (gfc_trans_allocate): Take care of coarrays as - argument to source=-expression. - -2016-02-02 Nathan Sidwell <nathan@codesourcery.com> - - * lang.opt (fopenacc-dim=): New option. - -2016-01-31 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/67564 - * trans-expr.c (gfc_conv_procedure_call): For the vtable copy - subroutines, add a string length argument, when the actual - argument is an unlimited polymorphic class object. - -2016-01-30 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/69566 - * trans-expr.c (gfc_conv_procedure_call): Correct expression - for 'ulim_copy', which was missing a test for 'comp'. - -2016-01-28 Andre Vehreschild <vehre@gcc.gnu.org> - - PR fortran/62536 - * decl.c (gfc_match_end): Only unnest and remove BLOCK namespaces - when the END encountered does not match a BLOCK's end. - -2016-01-27 Janus Weil <janus@gcc.gnu.org> - - PR fortran/69484 - * invoke.texi: Fix documentation of -Wall with respect to -Wtabs. - -2016-01-27 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/69422 - * trans-expr.c (is_scalar_reallocatable_lhs): Remove the check - for allocatable components, whilst checking if the symbol is a - derived or class entity.. - -2016-01-26 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/69385 - * trans-expr.c (gfc_trans_assignment_1): Exclude initialization - assignments from check on assignment of scalars to unassigned - arrays and correct wrong code within the corresponding block. - -2016-01-26 David Malcolm <dmalcolm@redhat.com> - - PR other/69006 - * error.c (gfc_diagnostic_starter): Delete use of pp_newline. - -2016-01-23 Jerry DeLisle <jvdelisle@gcc.gnu.org> - - PR fortran/69397 - PR fortran/68442 - * interface.c (gfc_arglist_matches_symbol): Replace assert with - a return false if not a procedure. - * resolve.c (resolve_generic_f): Test if we are resolving an - initialization expression and adjust error message accordingly. - -2016-01-24 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/66094 - * frontend-passes.c (matmul_lhs_realloc): Add - forgotten break statement. - -2016-01-24 Dominique d'Humieres <dominiq@lps.ens.fr> - - PR fortran/68283 - * primary.c (gfc_variable_attr): revert revision r221955, - call gfc_internal_error only if there is no error. - -2016-01-24 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/66094 - * frontend-passes.c (enum matrix_case): Add case A2B2T for - MATMUL(A,TRANSPoSE(B)) where A and B are rank 2. - (inline_limit_check): Also add A2B2T. - (matmul_lhs_realloc): Handle A2B2T. - (check_conjg_variable): Rename to - (check_conjg_transpose_variable): and also count TRANSPOSE. - (inline_matmul_assign): Handle A2B2T. - -2016-01-21 Jerry DeLisle <jvdelisle@gcc.gnu.org> - - PR fortran/65996 - * error.c (gfc_error): Save the state of abort_on_error and set - it to false for buffered errors to allow normal processing. - Restore the state before leaving. - -2016-01-19 Martin Jambor <mjambor@suse.cz> - - * types.def (BT_FN_VOID_UINT_PTR_INT_PTR): New. - (BT_FN_VOID_INT_OMPFN_SIZE_PTR_PTR_PTR_UINT_PTR_INT_INT): Removed. - (BT_FN_VOID_INT_OMPFN_SIZE_PTR_PTR_PTR_UINT_PTR_PTR): New. - -2016-01-15 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/64324 - * resolve.c (check_uop_procedure): Prevent deferred length - characters from being trapped by assumed length error. - - PR fortran/49630 - PR fortran/54070 - PR fortran/60593 - PR fortran/60795 - PR fortran/61147 - PR fortran/64324 - * trans-array.c (gfc_conv_scalarized_array_ref): Pass decl for - function as well as variable expressions. - (gfc_array_init_size): Add 'expr' as an argument. Use this to - correctly set the descriptor dtype for deferred characters. - (gfc_array_allocate): Add 'expr' to the call to - 'gfc_array_init_size'. - * trans.c (gfc_build_array_ref): Expand logic for setting span - to include indirect references to character lengths. - * trans-decl.c (gfc_get_symbol_decl): Ensure that deferred - result char lengths that are PARM_DECLs are indirectly - referenced both for directly passed and by reference. - (create_function_arglist): If the length type is a pointer type - then store the length as the 'passed_length' and make the char - length an indirect reference to it. - (gfc_trans_deferred_vars): If a character length has escaped - being set as an indirect reference, return it via the 'passed - length'. - * trans-expr.c (gfc_conv_procedure_call): The length of - deferred character length results is set TREE_STATIC and set to - zero. - (gfc_trans_assignment_1): Do not fix the rse string_length if - it is a variable, a parameter or an indirect reference. Add the - code to trap assignment of scalars to unallocated arrays. - * trans-stmt.c (gfc_trans_allocate): Remove 'def_str_len' and - all references to it. Instead, replicate the code to obtain a - explicitly defined string length and provide a value before - array allocation so that the dtype is correctly set. - trans-types.c (gfc_get_character_type): If the character length - is a pointer, use the indirect reference. - -2016-01-10 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/69154 - * frontend-passes.c (in_where): New variable. - (inline_matmul_assign): Don't try this if we are within - a WHERE statement. - (gfc_code_walker): Keep track of in_where. - -2016-01-10 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/67779 - * trans_array.c (gfc_conv_scalarized_array_ref): Add missing - se->use_offset from condition for calculation of 'base'. - -2016-01-08 Jakub Jelinek <jakub@redhat.com> - - PR fortran/69128 - * trans.h (OMPWS_SCALARIZER_BODY): Define. - (OMPWS_NOWAIT): Renumber. - * trans-stmt.c (gfc_trans_where_3): Only set OMPWS_SCALARIZER_WS - if OMPWS_SCALARIZER_BODY is not set already, and set also - OMPWS_SCALARIZER_BODY until the final loop creation. - * trans-expr.c (gfc_trans_assignment_1): Likewise. - * trans-openmp.c (gfc_trans_omp_workshare): Also clear - OMPWS_SCALARIZER_BODY. - * trans-array.c (gfc_trans_scalarized_loop_end): Don't create - OMP_FOR if OMPWS_SCALARIZER_BODY is set. - -2016-01-04 Jakub Jelinek <jakub@redhat.com> + * openmp.c (resolve_omp_clauses): Error on directives + containing both tile and collapse clauses. + (resolve_oacc_loop_blocks): Represent '*' tile arguments as zero. + * trans-openmp.c (gfc_trans_omp_do): Lower tiled loops like + collapsed loops. + +2017-02-07 Steven G. Kargl <kargl@gcc.gnu.org> + + * trans-types.c (gfc_get_int_kind_from_width_isofortranen): Choose + REAL type with the widest precision if two (or more) have the same + storage size. + +2017-02-05 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/79344 + * trans-stmt.c (gfc_trans_allocate): Only deallocate the components of + the temporary, when a new object was created for the temporary. Not + when it is just an alias to an existing object. + +2017-02-05 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/79335 + * trans-decl.c (generate_coarray_sym_init): Retrieve the symbol's + attributes before using them. + +2017-02-05 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/78958 + * trans-stmt.c (gfc_trans_allocate): Add the multiplying the _len + component of unlimited polymorphic objects when source-allocating. + +2017-02-05 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/79230 + * trans-array.c (structure_alloc_comps): Ignore pointer components when + freeing structures. + +2017-01-25 Maxim Ostapenko <m.ostapenko@samsung.com> + + PR lto/79061 + * f95-lang.c (gfc_create_decls): Include stringpool.h. + Pass main_input_filename to build_translation_unit_decl. + +2017-01-23 Thomas Koenig <tkoenig@netcologne.de> + + * arith.c (arith_power): If simplifying integer power expression + to zero, warn if -Winteger-division is given. + +2017-01-22 Jakub Jelinek <jakub@redhat.com> + + PR fortran/79154 + * parse.c (matchs, matcho, matchds, matchdo): Replace return st; + with { ret = st; goto finish; }. + (decode_omp_directive): Allow declare simd, declare target and + simd directives in PURE/ELEMENTAL procedures. Only call + gfc_unset_implicit_pure on successful match of other procedures. + +2017-01-21 Gerald Pfeifer <gerald@pfeifer.com> + + * gfc-internals.texi (Symbol Versioning): Change references + to www.akkadia.org to https. + +2017-01-21 Jakub Jelinek <jakub@redhat.com> + + * gfortran.h (gfc_extract_int): Change return type to bool. Add + int argument with = 0. + * decl.c (gfc_match_kind_spec): Adjust gfc_extract_int caller, pass + 1 as new last argument to it, don't emit gfc_error. + (match_char_kind): Likewise. + (gfc_match_decl_type_spec): Use gfc_get_string ("%s", x) instead of + gfc_get_string (x). + (gfc_match_derived_decl, match_binding_attributes): Likewise. + (gfc_match_structure_decl): Don't sprintf back to name, call + get_struct_decl directly with gfc_dt_upper_string (name) result. + * trans-stmt.c (gfc_trans_allocate): Use gfc_get_string ("%s", x) + instead of gfc_get_string (x). + * module.c (gfc_dt_lower_string, gfc_dt_upper_string, + gfc_match_use, gfc_match_submodule, find_true_name, mio_pool_string, + mio_symtree_ref, mio_expr, mio_omp_udr_expr, load_generic_interfaces, + load_omp_udrs, load_needed, read_module, dump_module, + create_intrinsic_function, import_iso_c_binding_module, + create_int_parameter, create_int_parameter_array, create_derived_type, + use_iso_fortran_env_module): Likewise. + * error.c (gfc_diagnostic_starter, gfc_diagnostic_start_span): Use + pp_verbatim (context->printer, "%s", x) instead of + pp_verbatim (context->printer, x). + * match.c (gfc_match_small_int): Adjust gfc_extract_int caller, pass + 1 as new last argument to it, don't emit gfc_error. + (gfc_match_small_int_expr): Likewise. + * iresolve.c (gfc_get_string): Optimize format "%s" case. + (resolve_bound): Use gfc_get_string ("%s", x) instead of + gfc_get_string (x). + (resolve_transformational): Formatting fix. + (gfc_resolve_char_achar): Change name argument to bool is_achar, + use a single format string and if is_achar add "a" before "char". + (gfc_resolve_achar, gfc_resolve_char): Adjust callers. + * expr.c (gfc_extract_int): Change return type to bool, return true + if some error occurred. Add REPORT_ERROR argument, if non-zero + call either gfc_error or gfc_error_now depending on its sign. + * arith.c (arith_power): Adjust gfc_extract_int caller. + * symbol.c (gfc_add_component): Use gfc_get_string ("%s", x) instead + of gfc_get_string (x). + (gfc_new_symtree, gfc_delete_symtree, gfc_get_uop, gfc_new_symbol, + gfc_get_gsymbol, generate_isocbinding_symbol): Likewise. + * openmp.c (gfc_match_omp_clauses): Adjust gfc_extract_int caller, pass + -1 as new last argument to it, don't emit gfc_error_now. + (gfc_match_omp_declare_reduction): Use gfc_get_string ("%s", x) + instead of gfc_get_string (x). + * check.c (kind_check): Adjust gfc_extract_int caller. + * intrinsic.c (add_sym, find_sym, make_alias): Use + gfc_get_string ("%s", x) instead of gfc_get_string (x). + * simplify.c (get_kind, gfc_simplify_btest, gfc_simplify_maskr, + gfc_simplify_maskl, gfc_simplify_poppar, gfc_simplify_repeat, + gfc_simplify_selected_int_kind, gfc_simplify_selected_real_kind): + Adjust gfc_extract_int callers. + * trans-decl.c (gfc_find_module): Use gfc_get_string ("%s", x) + instead of gfc_get_string (x). + * matchexp.c (expression_syntax): Add const. + * primary.c (match_kind_param, match_hollerith_constant, + match_string_constant): Adjust gfc_extract_int callers. + (match_keyword_arg): Use gfc_get_string ("%s", x) instead of + gfc_get_string (x). + * frontend-passes.c (optimize_minmaxloc): Likewise. + +2017-01-19 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/70696 + * trans-decl.c (gfc_build_qualified_array): Add static decl to parent + function only, when the decl-context is not the translation unit. + +2017-01-18 Louis Krupp <louis.krupp@zoho.com> + + PR fortran/50069 + PR fortran/55086 + * trans-expr.c (gfc_conv_variable): Don't treat temporary variables + as function arguments. + * trans-stmt.c (forall_make_variable_temp, + generate_loop_for_temp_to_lhs, gfc_trans_assign_need_temp, + gfc_trans_forall_1): Don't adjust offset of forall temporary + for array sections, make forall temporaries work for substring + expressions, improve test coverage by adding -ftest-forall-temp + option to request usage of temporary array in forall code. + * lang.opt: Add -ftest-forall-temp option. + * invoke.texi: Add -ftest-forall-temp option. + +2017-01-18 Andre Vehreschild <vehre@gcc.gnu.org> + + * primary.c (caf_variable_attr): Improve figuring whether the current + component is the last one refed. + * trans-stmt.c (gfc_trans_allocate): Do not generate sync_all calls + when allocating pointer or allocatable components. + +2017-01-18 Andre Vehreschild <vehre@gcc.gnu.org> + + * gfortran.texi: Add missing parameters to caf-API functions. Correct + typos and clarify some descriptions. + +2017-01-18 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/70696 + Missed some cases, here they are: + * trans-decl.c (gfc_build_qualified_array): Add static tokens to the + parent function's scope. + * trans-expr.c (gfc_get_tree_for_caf_expr): Shorten code. Remove + unnecessary assert. + +2017-01-13 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/70697 + * resolve.c (resolve_lock_unlock_event): Resolve the expression for + event's until_count. + +2017-01-13 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/70696 + * trans-expr.c (gfc_get_tree_for_caf_expr): Ensure the backend_decl + is valid before accessing it. + +2017-01-09 Jakub Jelinek <jakub@redhat.com> + + PR translation/79019 + PR translation/79020 + * decl.c (attr_decl1): Fix spelling in translatable string. + * intrinsic.texi: Fix spelling - invokation -> invocation. + * lang.opt (faggressive-function-elimination, gfc_convert): Fix + typos in descriptions. + * openmp.c (resolve_omp_clauses): Add missing whitespace to + translatable strings. + +2017-01-08 Martin Sebor <msebor@redhat.com> + + PR tree-optimization/78913 + PR middle-end/77708 + * trans-common.c (build_equiv_decl): Increase buffer size to avoid + truncation for any argument. + * trans-types.c (gfc_build_logical_type): Same. + +2017-01-07 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/78781 + PR fortran/78935 + * expr.c (gfc_check_pointer_assign): Return the same error message for + rewritten coarray pointer assignments like for plain ones. + * gfortran.h: Change prototype. + * primary.c (caf_variable_attr): Set attributes used ones only only + ones. Add setting of pointer_comp attribute. + (gfc_caf_attr): Add setting of pointer_comp attribute. + * trans-array.c (gfc_array_allocate): Add flag that the component to + allocate is not an ultimate coarray component. Add allocation of + pointer arrays. + (structure_alloc_comps): Extend nullify to treat pointer components in + coarrays correctly. Restructure nullify to remove redundant code. + (gfc_nullify_alloc_comp): Allow setting caf_mode flags. + * trans-array.h: Change prototype of gfc_nullify_alloc_comp (). + * trans-decl.c (generate_coarray_sym_init): Call nullify_alloc_comp for + derived type coarrays with pointer components. + * trans-expr.c (gfc_trans_structure_assign): Also treat pointer + components. + (trans_caf_token_assign): Handle assignment of token of scalar pointer + components. + (gfc_trans_pointer_assignment): Call above routine. + * trans-intrinsic.c (conv_expr_ref_to_caf_ref): Add treating pointer + components. + (gfc_conv_intrinsic_caf_get): Likewise. + (conv_caf_send): Likewise. + * trans-stmt.c (gfc_trans_allocate): After allocating a derived type in + a coarray pre-register the tokens. + (gfc_trans_deallocate): Simply determining the coarray type (scalar or + array) and deregistering it correctly. + * trans-types.c (gfc_typenode_for_spec): Replace in_coarray flag by the + actual codim to allow lookup of array types in the cache. + (gfc_build_array_type): Likewise. + (gfc_get_array_descriptor_base): Likewise. + (gfc_get_array_type_bounds): Likewise. + (gfc_get_derived_type): Likewise. + * trans-types.h: Likewise. + * trans.c (gfc_deallocate_with_status): Enable deregistering of all kind + of coarray components. + (gfc_deallocate_scalar_with_status): Use free() in fcoarray_single mode + instead of caf_deregister. + +2017-01-06 Jakub Jelinek <jakub@redhat.com> + + * simplify.c (simplify_transformation_to_array): Use + GCC_DIAGNOSTIC_PUSH_IGNORED and GCC_DIAGNOSTIC_POP instead of + #pragma GCC diagnostic {push,ignored,pop}. + +2017-01-06 Alexandre Oliva <aoliva@redhat.com> + + * simplify.c (simplify_transformation_to_array): Silence + array bounds warning. Fix whitespace. + +2017-01-04 Alexandre Oliva <aoliva@redhat.com> + + * module.c (load_omp_udrs): Initialize name. + +2017-01-02 Janne Blomqvist <jb@gcc.gnu.org> + + PR fortran/78534 + * trans-expr.c (gfc_trans_string_copy): Rework string copy + algorithm to avoid -Wstringop-overflow warning. + +2017-01-01 Jakub Jelinek <jakub@redhat.com> Update copyright years. @@ -729,14 +573,8 @@ * gfortran.texi: Ditto. * intrinsic.texi: Ditto. * invoke.texi: Ditto. - -2016-01-01 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/68864 - * trans-array.c (evaluate_bound): If deferred, test that 'desc' - is an array descriptor before using gfc_conv_descriptor_xxx. -Copyright (C) 2016 Free Software Foundation, Inc. +Copyright (C) 2017 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-2016 b/gcc/fortran/ChangeLog-2016 new file mode 100644 index 0000000000..ce640321da --- /dev/null +++ b/gcc/fortran/ChangeLog-2016 @@ -0,0 +1,2994 @@ +2016-12-27 Jakub Jelinek <jakub@redhat.com> + + * gfortran.h (gfc_error): Rename overload with OPT argument to... + (gfc_error_opt): ... this. + * error.c (gfc_error): Rename overloads with OPT argument to... + (gfc_error_opt): ... this. Adjust callers. + (gfc_notify_std, gfc_error): Adjust callers. + * resolve.c (resolve_structure_cons, resolve_global_procedure): Use + gfc_error_opt instead of gfc_error. + * interface.c (argument_rank_mismatch, compare_parameter, + gfc_check_typebound_override): Likewise. Fix up formatting. + +2016-12-23 Andre Vehreschild <vehre@gcc.gnu.org> + + * trans-expr.c (trans_class_assignment): Allocate memory of _vptr->size + before assigning an allocatable class object. + (gfc_trans_assignment_1): Flag that (re-)alloc of the class object + shall be done. + +2016-12-21 Jakub Jelinek <jakub@redhat.com> + + PR fortran/78866 + * openmp.c (resolve_omp_clauses): Diagnose assumed size arrays in + OpenMP map, to and from clauses. + * trans-openmp.c: Include diagnostic-core.h, temporarily redefining + GCC_DIAG_STYLE to __gcc_tdiag__. + (gfc_omp_finish_clause): Diagnose implicitly mapped assumed size + arrays. + +2016-12-21 Janne Blomqvist <jb@gcc.gnu.org> + + PR fortran/78867 + * trans-expr.c (gfc_conv_procedure_call): Emit DECL_EXPR also for + non-pointer character results. + +2016-12-21 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + * iresolve.c (gfc_resolve_ftell): Call "ftell" instead of "ftell2". + +2016-12-20 Janne Blomqvist <jb@gcc.gnu.org> + + * trans-types.c (gfc_init_types): Don't redefine boolean type node. + +2016-12-19 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + * trans-decl.c (create_main_function): Remove unused elements to + the set_options call. + +2016-12-19 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + * trans.h: Remove gfor_fndecl_stop_numeric_f08. + * trans-decl.c: Remove gfor_fndecl_stop_numeric_f08. + * trans-stmt.c (gfc_trans_stop): Use gfor_fndecl_stop_numeric + instead of gfor_fndecl_stop_numeric_f08. + +2016-12-19 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78545 + * intrinsic.texi: Minor documentation fixes for non-standard + time-related intrinsics. Add references to standard intrinsics and + linkify some existing references. + +2016-12-18 Dominique d'Humieres <dominiq@lps.ens.fr> + + PR fortran/78545 + * intrinsic.texi: Fix documentation for GMTIME and LTIME. + +2016-12-18 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78848 + * trans-io.c (get_dtio_proc): Generate non-typebound DTIO call for class + variables, if no typebound DTIO procedure is available. + +2016-12-18 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78592 + * interfac.c (gfc_find_specific_dtio_proc): Fixup for r243005, making + sure that the generic list is followed through until the end. + +2016-12-17 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78239 + * decl.c (char_len_param_value): Actually commit previous change. + +2016-12-17 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78239 + * decl.c( char_len_param_value): Also check for -fimplicit-none + when determining if implicit none is in force. + +2016-12-16 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/78622 + * io.c (format_lex): Continue of string delimiter seen. + +2016-12-16 Jakub Jelinek <jakub@redhat.com> + + PR fortran/78757 + * trans-expr.c (gfc_conv_procedure_call): Emit DECL_EXPR for the + type pstr var points to. + +2016-12-15 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78798 + * gfortran.h (gfc_compare_derived_types,gfc_compare_types, + gfc_compare_interfaces,gfc_has_vector_subscript): Return bool instead + of int. + * interface.c (compare_components): Ditto. + (gfc_compare_union_types): Rename to compare_union_types, declare as + static, return bool. + (gfc_compare_derived_types): Return bool instead of int. + (gfc_compare_types): Ditto. + (compare_type): Ditto. + (compare_rank): Ditto. + (compare_type_rank): Ditto. + (compare_type_rank_if): Ditto. + (count_types_test): Ditto. + (generic_correspondence): Ditto. + (gfc_compare_interfaces): Ditto. + (check_interface0): Ditto. + (check_interface1): Ditto. + (compare_allocatable): Ditto. + (compare_parameter): Ditto. + (gfc_has_vector_subscript): Ditto. + (compare_actual_formal): Ditto. + +2016-12-15 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78800 + * interface.c (compare_allocatable): Avoid additional errors on bad + class declarations. + (compare_parameter): Put the result of gfc_expr_attr into a variable, + in order to avoid calling it multiple times. Exit early on bad class + declarations to avoid ICE. + +2016-12-14 Martin Jambor <mjambor@suse.cz> + + * trans-openmp.c: Include omp-general.h. + +2016-12-14 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/78780 + * trans-expr.c (gfc_trans_assignment_1): Improve check whether detour + caf-runtime routines is needed. + +2016-12-14 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/78672 + * array.c (gfc_find_array_ref): Add flag to return NULL when no ref is + found instead of erroring out. + * data.c (gfc_assign_data_value): Only constant expressions are valid + for initializers. + * gfortran.h: Reflect change of gfc_find_array_ref's signature. + * interface.c (compare_actual_formal): Access the non-elemental + array-ref. Prevent taking a REF_COMPONENT for a REF_ARRAY. Correct + indentation. + * module.c (load_omp_udrs): Clear typespec before reading into it. + * trans-decl.c (gfc_build_qualified_array): Prevent accessing the array + when it is a coarray. + * trans-expr.c (gfc_conv_cst_int_power): Use wi::abs()-function instead + of crutch preventing sanitizer's bickering here. + * trans-stmt.c (gfc_trans_deallocate): Only get data-component when it + is a descriptor-array here. + +2016-12-13 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78798 + * gfortran.h (gfc_is_constant_expr, gfc_is_formal_arg, + gfc_is_compile_time_shape): Return bool instead of int. + * array.c (gfc_is_compile_time_shape): Ditto. + * expr.c (gfc_is_constant_expr): Ditto. + * resolve.c (gfc_is_formal_arg): Ditto. Make formal_arg_flag bool. + +2016-12-13 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/77785 + * resolve.c (resolve_symbol): Correct attr lookup to the _data + component. + * trans-array.c (gfc_alloc_allocatable_for_assignment): Indirect ref + pointers and references before retrieving the caf-token. + +2016-12-13 Janus Weil <janus@gcc.gnu.org> + Paul Thomas <pault@gcc.gnu.org> + + PR fortran/78737 + * gfortran.h (gfc_find_typebound_dtio_proc): New prototype. + * interface.c (gfc_compare_interfaces): Whitespace fix. + (gfc_find_typebound_dtio_proc): New function. + (gfc_find_specific_dtio_proc): Use it. Improve error recovery. + * trans-io.c (get_dtio_proc): Implement polymorphic calls to DTIO + procedures. + +2016-12-12 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78392 + * expr.c (gfc_is_constant_expr): Specification functions are not + compile-time constants. Update documentation (add reference to F08 + standard), add a FIXME. + (external_spec_function): Add reference to F08 standard. + * resolve.c (resolve_fl_variable): Ditto. + +2016-12-10 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78226 + * error.c (gfc_warning_internal): New function. + * frontend-passes.c (gfc_run_passes): Call check_locus if + CHECKING_P is defined. + (check_locus_code): New function. + (check_locus_expr): New function. + (check_locus): New function. + * gfortran.h: Add prototype for gfc_warning_internal. + +2016-12-10 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/78350 + * resolve.c (resolve_structure_cons): Remove the block that + tried to remove a charlen and rely on namespace cleanup. + +2016-12-09 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/77903 + * decl.c (get_proc_name): Use the symbol tlink field instead of + the typespec interface field. + (gfc_match_function_decl, gfc_match_submod_proc): Ditto. + * gfortran.h : Since the symbol tlink field is no longer used + by the frontend for change management, change the comment to + reflect its current uses. + * parse.c (get_modproc_result): Same as decl.c changes. + * resolve.c (resolve_fl_procedure): Ditto. + +2016-12-09 Janus Weil <janus@gcc.gnu.org> + + PR fortran/61767 + * class.c (has_finalizer_component): Fix this function to detect only + non-pointer non-allocatable components which have a finalizer. + +2016-12-09 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/78505 + * trans-stmt.c (gfc_trans_allocate): Add sync all after the execution + of the whole allocate-statement to adhere to the standard. + +2016-12-09 Andre Vehreschild <vehre@gcc.gnu.org> + + * trans-array.c (gfc_array_deallocate): Remove wrapper. + (gfc_trans_dealloc_allocated): Same. + (structure_alloc_comps): Restructure deallocation of (nested) + allocatable components. Insert dealloc of sub-component into the block + guarded by the if != NULL for the component. + (gfc_trans_deferred_array): Use the almightly deallocate_with_status. + * trans-array.h: Remove prototypes. + * trans-expr.c (gfc_conv_procedure_call): Use the almighty deallocate_ + with_status. + * trans-openmp.c (gfc_walk_alloc_comps): Likewise. + (gfc_omp_clause_assign_op): Likewise. + (gfc_omp_clause_dtor): Likewise. + * trans-stmt.c (gfc_trans_deallocate): Likewise. + * trans.c (gfc_deallocate_with_status): Allow deallocation of scalar + and arrays as well as coarrays. + (gfc_deallocate_scalar_with_status): Get the data member for coarrays + only when freeing an array with descriptor. And set correct caf_mode + when freeing components of coarrays. + * trans.h: Change prototype of gfc_deallocate_with_status to allow + adding statements into the block guarded by the if (pointer != 0) and + supply a coarray handle. + +2016-12-09 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/44265 + * gfortran.h : Add fn_result_spec bitfield to gfc_symbol. + * resolve.c (flag_fn_result_spec): New function. + (resolve_fntype): Call it for character result lengths. + * symbol.c (gfc_new_symbol): Set fn_result_spec to zero. + * trans-decl.c (gfc_sym_mangled_identifier): Include the + procedure name in the mangled name for symbols with the + fn_result_spec bit set. + (gfc_finish_var_decl): Mark the decls of these symbols + appropriately for the case where the function is external. + (gfc_get_symbol_decl): Mangle the name of these symbols. + (gfc_create_module_variable): Allow them through the assert. + (gfc_generate_function_code): Remove the assert before the + initialization of sym->tlink because the frontend no longer + uses this field. + * trans-expr.c (gfc_map_intrinsic_function): Add a case to + treat the LEN_TRIM intrinsic. + (gfc_trans_string_copy): Deal with Wstringop-overflow warning + that can occur with constant source lengths at -O3. + +2016-12-08 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/65173 + PR fortran/69064 + PR fortran/69859 + PR fortran/78350 + * gfortran.h (gfc_namespace): Remove old_cl_list member. + * parse.c (use_modules, next_statement): old_cl_list is gone. + (clear_default_charlen): Remove no longer used function. + (reject_statement): Do not try ot clean up gfc_charlen structure(s) + that may have been added to a cl_list list. + * symbol.c (gfc_new_charlen): old_cl_list structure is gone. + +2016-12-06 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/78659 + * resolve.c (resolve_fl_namelist): Remove unneeded error. + +2016-12-06 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/78226 + * class.c (finalize_component): Add missing locus information. + (finalization_scalarizer): Likewise. + (finalization_get_offset): Likewise. + (finalizer_insert_packed_call): Likewise. + (generate_finalization_wrapper): Likewise. + +2016-12-05 Nathan Sidwell <nathan@acm.org> + + * error.c (gfc_warning_check): Call diagnostic_check_max_errors. + (gfc_error_check): Likewise. + +2016-12-04 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78618 + * intrinsic.c (gfc_convert_type_warn): Do not set the full typespec for + the conversion symbol, but only type and kind. Set the full typespec + for the expression. + (gfc_convert_chartype): Ditto. + +2016-12-03 Janus Weil <janus@gcc.gnu.org> + + PR fortran/43207 + * primary.c (gfc_match_varspec): Reject nonpolymorphic references to + abstract types. + +2016-12-03 Janus Weil <janus@gcc.gnu.org> + + PR fortran/42188 + * primary.c (gfc_match_rvalue): Add a new check that gives better error + messages. + +2016-12-03 Janus Weil <janus@gcc.gnu.org> + + PR fortran/58175 + * resolve.c (gfc_resolve_finalizers): Prevent bogus warning. + +2016-12-02 Steven G. Kargl <kargl@gcc.gnu.org> + + * simplify.c (gfc_convert_char_constant): Free result on error. + +2016-12-02 Janus Weil <janus@gcc.gnu.org> + Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/78618 + * check.c (gfc_check_rank): Remove ATTRIBUTE_UNUSED. + * expr.c (gfc_check_assign): Fix error propagation. + +2016-12-01 Elizebeth Punnoose <elizebeth.punnoose@hpe.com> + + PR fortran/77505 + * trans-array.c (trans_array_constructor): Treat negative character + length as LEN = 0. + +2016-12-01 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/78279 + * dependency.c (identical_array_ref): Convert gcc_assert to conditional + and gfc_internal_error. + +2016-11-30 Andre Vehreschild <vehre@gcc.gnu.org> + + * check.c (gfc_check_allocated): By pass the caf_get call and check on + the array. + * gfortran.h: Add optional flag to gfc_caf_attr. + * gfortran.texi: Document new enum values and _caf_is_present function. + * primary.c (caf_variable_attr): Add optional flag to indicate that the + expression is reffing a component. + (gfc_caf_attr): Likewise. + * trans-array.c (gfc_array_deallocate): Handle deallocation mode for + coarray deregistration. + (gfc_trans_dealloc_allocated): Likewise. + (duplicate_allocatable): Use constants instead of + creating custom constant tree node of zero or one. Use gfc_add_modify + convenience function. + (duplicate_allocatable_coarray): This function is similar to + duplicate_allocatable but tailored to handle coarrays. + (caf_enabled): Check whether in-derived-type coarray processing is + enabled. + (caf_in_coarray): Check that in-derived-type coarray processing is + enabled and currently in a derived-typed coarray. + (gfc_caf_is_dealloc_only): Return true, when deallocate only is + desired for components in derived typed coarrays. + (structure_alloc_comps): A mode for handling coarrays, that is no + longer encode in the purpose. This makes the use cases of the + routine more flexible without repeating. Allocatable components in + derived type coarrays are now registered only when nullifying an + object and allocated before copying data into them. + (gfc_nullify_alloc_comp): Use the caf_mode of structure_alloc_comps + now. + (gfc_deallocate_alloc_comp): Likewise. + (gfc_deallocate_alloc_comp_no_caf): Likewise. + (gfc_reassign_alloc_comp_caf): Likewise. + (gfc_copy_alloc_comp): Likewise. + (gfc_copy_only_alloc_comp): Likewise. + (gfc_alloc_allocatable_for_assignment): Make use to the cheaper way of + reallocating a coarray without deregistering and reregistering it. + (gfc_trans_deferred_array): Initialize the coarray token correctly for + deferred variables and tear them down on exit. + * trans-array.h: Change some prototypes to add the coarray (de-) + registration modes. Add prototype for checking if deallocate only is + selected for components in derived typed coarrays. + * trans-decl.c (gfc_build_builtin_function_decls): Generate the + declarations for the changed/new caf-lib routines. + (gfc_trans_deferred_vars): Ensure deferred variables are (de-) + registered correctly on procedure entry/exit. + (generate_coarray_sym_init): Use constants. + * trans-expr.c (gfc_conv_procedure_call): Propagate coarray allocation + modes accordingly. + (gfc_trans_alloc_subarray_assign): Likewise. + (gfc_trans_subcomponent_assign): Likewise. + (gfc_trans_structure_assign): Generate code to register the components + of a derived type coarray prior to initialization. + (gfc_conv_structure): Set flag that the structure is in a coarray. + (gfc_trans_scalar_assign): Add flag to indicate being in a coarray and + set the structure_alloc_comps modes correctly. + (gfc_trans_assignment_1): Figure being in a coarray expression. + * trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Adapt to new + structure_alloc_comps interface. + (conv_caf_send): Use the old API as long as possible. + (trans_caf_is_present): Generate code to check whether an allocatable + component in a derived typed coarray is allocated on a remote image. + (caf_this_image_ref): Return true, when only reffing this image. + (gfc_conv_allocated): Convert allocated queries on allocatable + components to the library API. + (conv_intrinsic_move_alloc): Adapt to new interface of + structure_alloc_comps. + * trans-openmp.c (gfc_walk_alloc_comps): Likewise. + (gfc_omp_clause_assign_op): Likewise. + (gfc_omp_clause_dtor): Likewise. + * trans-stmt.c (gfc_trans_deallocate): Figure which mode to use when + deallocating allocatable components in derived type coarras. + * trans.c (gfc_allocate_using_lib): Renamed to + gfc_allcate_using_caf_lib. + (gfc_allocate_allocatable): Set the registration mode/type of caf- + register calls adapting to all the possible allocatable objects. + (gfc_deallocate_with_status): Add deregistration mode for allocatable + components in derived type coarrays. + (gfc_deallocate_scalar_with_status): Likewise. + * trans.h (enum gfc_coarray_type): Renamed to gfc_coarray_regtype to + avoid collision with gfc_coarray_deregtype. + +2016-11-30 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78593 + * primary.c (gfc_match_varspec): Check if sym is non-null to avoid ICE. + +2016-11-30 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78592 + * interface.c (gfc_find_specific_dtio_proc): Rearrange code to avoid + dereferencing a null pointer. + +2016-11-30 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78573 + * decl.c (build_struct): On error, return directly and do not build + class symbol. + +2016-11-29 Tobias Burnus <burnus@net-b.de> + + PR fortran/58175 + * resolve.c (gfc_resolve_finalizers): Properly detect scalar finalizers. + +2016-11-27 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/78474 + * module.c (gfc_match_submodule): If there is more than one + colon, it is a syntax error. + + PR fortran/78331 + * module.c (gfc_use_module): If an smod file does not exist it + is either because the module does not have a module procedure + interface or there is an error in the module. + +2016-11-25 Janne Blomqvist <jb@gcc.gnu.org> + + * intrinsic.texi: Fix ptrdiff_t typo in ISO_C_BINDING constants + table. + +2016-11-25 Janus Weil <janus@gcc.gnu.org> + + PR fortran/60853 + * interface.c (gfc_compare_interfaces): Remove bad special case for + unlimited polymorphism. Refactor for loop. + +2016-11-25 Andre Vehreschild <vehre@gcc.gnu.org> + Paul Thomas <pault@gcc.gnu.org> + + PR fortran/78293 + * trans-expr.c (gfc_conv_procedure_call): Prepend deallocation + of alloctable components to post, rather than adding to + se->post. + * trans-stmt.c (gfc_trans_allocate): Move deallocation of expr3 + allocatable components so that all expr3s are visited. + +2016-11-25 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/78293 + * gfortran.dg/allocatable_function_10.f90: New test. + * gfortran.dg/class_array_15.f03: Increase builtin_free count + from 11 to 12. + +2016-11-24 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/78500 + * expr.c (gfc_check_vardef_contextm): Fix NULL pointer dereference. + * interface.c (matching_typebound_op): Ditto. + +2016-11-23 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/78297 + * trans-common.c (finish_equivalences): Do not dereference a NULL pointer. + +2016-11-23 Martin Jambor <mjambor@suse.cz> + + * f95-lang.c (DEF_HSA_BUILTIN): New macro. + +2016-11-22 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/78479 + * expr.c (gfc_apply_init): Allocate a charlen if needed. + +2016-11-22 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78443 + * class.c (add_proc_comp): Add a vtype component for non-overridable + procedures that are overriding. + +2016-11-20 Harald Anlauf <anlauf@gmx.de> + + PR fortran/69741 + * resolve.c (gfc_resolve_forall): Check for nonscalar index variables. + +2016-11-20 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/78395 + * resolve.c (resolve_typebound_function): Prevent stripping of refs, + when the base-expression is a class' typed one. + +2016-11-18 Richard Sandiford <richard.sandiford@arm.com> + Alan Hayward <alan.hayward@arm.com> + David Sherwood <david.sherwood@arm.com> + + * trans-common.c (build_common_decl): Use SET_DECL_MODE. + * trans-decl.c (gfc_build_label_decl): Likewise. + * trans-types.c (gfc_get_array_descr_info): Likewise. + +2016-11-17 Janus Weil <janus@gcc.gnu.org> + + PR fortran/66227 + * simplify.c (gfc_simplify_extends_type_of): Fix missed optimization. + Prevent over-simplification. Fix a comment. Add a comment. + +2016-11-16 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/58001 + * io.c (next_char_not_space): Update handling of a 'tab' in a FORMAT. + (format_lex): Adjust invocations of next_char_not_space(). + +2016-11-16 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/78356 + * class.c (gfc_is_class_scalar_expr): Prevent taking an array ref for + a component ref. + * trans-expr.c (gfc_trans_assignment_1): Ensure a reference to the + object to copy is generated, when assigning class objects. + +2016-11-14 Thomas Koenig <tkoenig@gcc.gnu.org> + + * dump-parse-tree.c (show_code): Add prototype. + (gfc_debug_code): New function. + (show_code_node): Add space after SELECT TYPE. + +2016-11-14 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78300 + * resolve.c (resolve_procedure_interface): Properly handle CLASS-valued + function results. + +2016-11-13 Janus Weil <janus@gcc.gnu.org> + + PR fortran/60952 + * decl.c (match_procedure_in_type): Apply the FL_PROCEDURE attribute + to the target procedure. + +2016-11-13 Janus Weil <janus@gcc.gnu.org> + + PR fortran/66366 + * resolve.c (resolve_component): Move check for C437 + to ... + * decl.c (build_struct): ... here. Fix indentation. + +2016-11-12 Janus Weil <janus@gcc.gnu.org> + + PR fortran/77501 + * class.c (gfc_find_typebound_intrinsic_op): Remove an unnecessary + assert and nullification. + * decl.c (gfc_match_decl_type_spec): Use gfc_get_tbp_symtree, + fix indentation. + (gfc_match_generic): Remove an unnecessary assert. + Use gfc_get_tbp_symtree to avoid ICE. + +2016-11-10 Fritz O. Reese <fritzoreese@gmail.com> + + PR fortran/78277 + * gcc/fortran/decl.c (gfc_match_data_decl): Gracefully handle bad + anonymous structure declarations. + +2016-11-10 Fritz O. Reese <fritzoreese@gmail.com> + + * decl.c (get_struct_decl, gfc_match_map, gfc_match_union): Fix + whitespace. + * interface.c (gfc_compare_union_types): Likewise. + +2016-11-10 Jakub Jelinek <jakub@redhat.com> + + * cpp.c (cpp_define_builtins): Define _OPENMP to 201511 instead + of 201307. + * gfortran.texi: Mention partial OpenMP 4.5 support. + * intrinsic.texi: Update for OpenMP 4.5. + + * openmp.c (gfc_free_omp_clauses): Free critical_name, grainsize, + hint, num_tasks, priority and if_exprs. + (gfc_match_omp_to_link, gfc_match_omp_depend_sink): New functions. + (enum omp_mask1, enum omp_mask2): New enums. + Change all OMP_CLAUSE_* defines into enum values, and change their + values from ((uint64_t) 1 << bit) to just bit. + (omp_mask, omp_inv_mask): New classes. Add ctors and operators. + (gfc_match_omp_clauses): Change mask argument from uint64_t to + const omp_mask. Assert OMP_MASK1_LAST and OMP_MASK2_LAST are + at most 64. Move delete clause handling to where it + alphabetically belongs. Parse defaultmap, grainsize, hint, + is_device_ptr, nogroup, nowait, num_tasks, priority, simd, threads + and use_device_ptr clauses. Parse if clause modifier. Parse map + clause always modifier, and release and delete kinds. Parse ordered + clause with argument. Parse schedule clause modifiers. Differentiate + device clause parsing based on openacc flag. Guard link clause + parsing with openacc flag. Add support for parsing + linear clause modifiers. Parse depend(source) and depend(sink: ...). + Use gfc_match_omp_to_link for to and link clauses in declare target + construct. + (match_acc): Change mask type from uint64_t to const omp_mask. + (OMP_SINGLE_CLAUSES, OMP_ORDERED_CLAUSES, + OMP_DECLARE_TARGET_CLAUSES, OMP_TASKLOOP_CLAUSES, + OMP_TARGET_ENTER_DATA_CLAUSES, OMP_TARGET_EXIT_DATA_CLAUSES): Define. + (OACC_PARALLEL_CLAUSES, OACC_KERNELS_CLAUSES, OACC_DATA_CLAUSES, + OACC_LOOP_CLAUSES, OACC_HOST_DATA_CLAUSES, OACC_DECLARE_CLAUSES, + OACC_ENTER_DATA_CLAUSES, OACC_EXIT_DATA_CLAUSES, OACC_WAIT_CLAUSES, + OACC_ROUTINE_CLAUSES, OMP_PARALLEL_CLAUSES, OMP_DECLARE_SIMD_CLAUSES, + OMP_SECTIONS_CLAUSES, OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES): + Replace first or only OMP_CLAUSE_* value in bitset with + omp_mask (OMP_CLAUSE_*). + (OMP_DO_CLAUSES): Likewise. Add OMP_CLAUSE_LINEAR. + (OMP_SIMD_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_SIMDLEN. + (OACC_UPDATE_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Replace OMP_CLAUSE_OACC_DEVICE + with OMP_CLAUSE_DEVICE. + (OMP_TASK_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_PRIORITY. + (OMP_TARGET_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_DEPEND, + OMP_CLAUSE_NOWAIT, OMP_CLAUSE_PRIVATE, OMP_CLAUSE_FIRSTPRIVATE, + OMP_CLAUSE_DEFAULTMAP and OMP_CLAUSE_IS_DEVICE_PTR. + (OMP_TARGET_DATA_CLAUSES): Replace first or only OMP_CLAUSE_* value in + bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_USE_DEVICE_PTR. + (OMP_TARGET_UPDATE_CLAUSES): Replace first or only OMP_CLAUSE_* value + in bitset with omp_mask (OMP_CLAUSE_*). Add OMP_CLAUSE_DEPEND and + OMP_CLAUSE_NOWAIT. + (match_omp): Change mask argument from unsigned int to + const omp_mask. + (gfc_match_omp_critical): Parse optional clauses and use omp_clauses + union member instead of omp_name. + (gfc_match_omp_end_critical): New function. + (gfc_match_omp_distribute_parallel_do): Remove ordered and linear + clauses from the mask. + (gfc_match_omp_distribute_parallel_do_simd): Use + & ~(omp_mask (OMP_CLAUSE_*)) instead of & ~OMP_CLAUSE_*. + (gfc_match_omp_target_teams_distribute_parallel_do_simd): Likewise. + (gfc_match_omp_teams_distribute_parallel_do_simd): Likewise. + (gfc_match_omp_do_simd): Likewise. Don't remove ordered clause from + the mask. + (gfc_match_omp_parallel_do_simd): Likewise. + (gfc_match_omp_target_teams_distribute_parallel_do): Likewise. + (gfc_match_omp_teams_distribute_parallel_do): Likewise. + (gfc_match_omp_declare_simd): If not using the form with + (proc-name), require space before first clause. Make (proc-name) + optional. If not present, set proc_name to NULL. + (gfc_match_omp_declare_target): Rewritten for OpenMP 4.5. + (gfc_match_omp_single): Use OMP_SINGLE_CLAUSES. + (gfc_match_omp_task, gfc_match_omp_taskwait, gfc_match_omp_taskyield): + Move around to where they belong alphabetically. + (gfc_match_omp_target_enter_data, gfc_match_omp_target_exit_data, + gfc_match_omp_target_parallel, gfc_match_omp_target_parallel_do, + gfc_match_omp_target_parallel_do_simd, gfc_match_omp_target_simd, + gfc_match_omp_taskloop, gfc_match_omp_taskloop_simd): + New functions. + (gfc_match_omp_ordered): Parse clauses. + (gfc_match_omp_ordered_depend): New function. + (gfc_match_omp_cancel, gfc_match_omp_end_single): Use + omp_mask (OMP_CLAUSE_*) instead of OMP_CLAUSE_*. + (resolve_oacc_scalar_int_expr): Renamed to ... + (resolve_scalar_int_expr): ... this. Fix up formatting. + (resolve_oacc_positive_int_expr): Renamed to ... + (resolve_positive_int_expr): ... this. Fix up formatting. + (resolve_nonnegative_int_expr): New function. + (resolve_omp_clauses): Adjust callers, use the above functions + even for OpenMP clauses, add handling of new OpenMP 4.5 clauses. + Require orderedc >= collapse if specified. Handle depend(sink:) + and depend(source) restrictions. Disallow linear clause when + orderedc is non-zero. Diagnose linear clause modifiers when not in + declare simd. Only check for integer type if ref modifier + is not used. Remove diagnostics for required VALUE attribute. + Diagnose VALUE attribute with ref or uval modifiers. Allow + non-constant linear-step, if it is a dummy argument alone and is + mentioned in uniform clause. Diagnose map kinds not allowed + for various constructs. Diagnose target {enter ,exit ,}data without + any map clauses. Add dummy OMP_LIST_IS_DEVICE_PTR and + OMP_LIST_USE_DEVICE_PTR cases. + (gfc_resolve_omp_do_blocks): Set omp_current_do_collapse to orderedc + if non-zero. + (gfc_resolve_omp_parallel_blocks): Handle new OpenMP 4.5 constructs, + replace underscores with spaces in a few construct names. + (resolve_omp_do): Set collapse to orderedc if non-zero. Handle new + OpenMP 4.5 constructs. + (resolve_oacc_loop_blocks): Call resolve_positive_int_expr instead + of resolve_oacc_positive_int_expr. + (gfc_resolve_omp_directive): Handle new OpenMP 4.5 constructs. + (gfc_resolve_omp_declare_simd): Allow ods->proc_name to be NULL. + * trans-openmp.c (gfc_omp_scalar_p): New function. + (doacross_steps): New variable. + (gfc_trans_omp_clauses): Handle new OpenMP 4.5 clauses and new clause + modifiers. + (gfc_trans_omp_critical): Adjust EXEC_OMP_CRITICAL handling. + (gfc_trans_omp_do): Handle doacross loops. Clear sched_simd flag. + Handle EXEC_OMP_TASKLOOP. + (gfc_trans_omp_ordered): Translate omp clauses, allow NULL + code->block. + (GFC_OMP_SPLIT_TASKLOOP, GFC_OMP_MASK_TASKLOOP): New enum constants. + (gfc_split_omp_clauses): Copy orderedc together with ordered. Change + firstprivate and lastprivate handling for OpenMP 4.5. + Handle EXEC_OMP_TARGET_SIMD, EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} + and EXEC_OMP_TASKLOOP{,_SIMD}. Add handling for new OpenMP 4.5 + clauses and clause modifiers and handle if clause without/with + modifiers. + (gfc_trans_omp_teams): Add omp_clauses argument, add it to other + teams clauses. Don't wrap into OMP_TEAMS if -fopenmp-simd. + (gfc_trans_omp_target): For -fopenmp, translate num_teams and + thread_limit clauses on combined target teams early and pass to + gfc_trans_omp_teams. Set OMP_TARGET_COMBINED if needed. + Handle EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} and + EXEC_OMP_TARGET_SIMD. + (gfc_trans_omp_taskloop, gfc_trans_omp_target_enter_data, + gfc_trans_omp_target_exit_data): New functions. + (gfc_trans_omp_directive): Handle EXEC_OMP_TARGET_{ENTER,EXIT}_DATA + EXEC_OMP_TASKLOOP{,_SIMD}, EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} + and EXEC_OMP_TARGET_SIMD. Adjust gfc_trans_omp_teams caller. + * symbol.c (check_conflict): Handle omp_declare_target_link. + (gfc_add_omp_declare_target_link): New function. + (gfc_copy_attr): Copy omp_declare_target_link. + * dump-parse-tree.c (show_omp_namelist): Handle OMP_DEPEND_SINK_FIRST + depend_op. Print linear clause modifiers. + (show_omp_clauses): Adjust for OpenMP 4.5 clause changes. + (show_omp_node): Print clauses for EXEC_OMP_ORDERED. Allow NULL + c->block for EXEC_OMP_ORDERED. Formatting fixes. Adjust handling of + EXEC_OMP_CRITICAL, handle new OpenMP 4.5 constructs and some + forgotten OpenMP 4.0 constructs. + (show_code_node): Handle new OpenMP 4.5 constructs and some forgotten + OpenMP 4.0 constructs. + * gfortran.h (symbol_attribute): Add omp_declare_target_link bitfield. + (struct gfc_omp_namelist): Add u.common and u.linear_op fields. + (struct gfc_common_head): Change omp_declare_target into bitfield. + Add omp_declare_target_link bitfield. + (gfc_add_omp_declare_target_link): New prototype. + (enum gfc_statement): Add ST_OMP_TARGET_PARALLEL, + ST_OMP_END_TARGET_PARALLEL, ST_OMP_TARGET_PARALLEL_DO, + ST_OMP_END_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, + ST_OMP_END_TARGET_PARALLEL_DO_SIMD, ST_OMP_TARGET_ENTER_DATA, + ST_OMP_TARGET_EXIT_DATA, ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, + ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_TASKLOOP_SIMD, + ST_OMP_END_TASKLOOP_SIMD and ST_OMP_ORDERED_DEPEND. + (enum gfc_omp_depend_op): Add OMP_DEPEND_SINK_FIRST and + OMP_DEPEND_SINK. + (enum gfc_omp_linear_op): New. + (struct gfc_omp_clauses): Add critical_name, depend_source, + orderedc, defaultmap, nogroup, sched_simd, sched_monotonic, + sched_nonmonotonic, simd, threads, grainsize, hint, num_tasks, + priority and if_exprs fields. + (enum gfc_exec_op): Add EXEC_OMP_END_CRITICAL, + EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA, + EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO, + EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD, + EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD. + (enum gfc_omp_map_op): Add OMP_MAP_RELEASE, + OMP_MAP_ALWAYS_TO, OMP_MAP_ALWAYS_FROM and OMP_MAP_ALWAYS_TOFROM. + (OMP_LIST_IS_DEVICE_PTR, OMP_LIST_USE_DEVICE_PTR): New. + (enum gfc_omp_if_kind): New. + * module.c (enum ab_attribute): Add AB_OMP_DECLARE_TARGET_LINK. + (attr_bits): Add AB_OMP_DECLARE_TARGET_LINK entry. + (mio_symbol_attribute): Save and restore omp_declare_target_link bit. + * trans.h (gfc_omp_scalar_p): New prototype. + * frontend-passes.c (gfc_code_walker): Handle new OpenMP 4.5 + expressions. + * trans.c (trans_code): Handle new OpenMP 4.5 constructs. + * resolve.c (gfc_resolve_blocks): Likewise. + (gfc_resolve_code): Likewise. + * f95-lang.c (LANG_HOOKS_OMP_SCALAR_P): Redefine to gfc_omp_scalar_p. + (gfc_attribute_table): Add "omp declare target link". + * st.c (gfc_free_statement): Handle EXEC_OMP_END_CRITICAL like + EXEC_OMP_CRITICAL before, free clauses for EXEC_OMP_CRITICAL + and new OpenMP 4.5 constructs. Free omp clauses even for + EXEC_OMP_ORDERED. + * match.c (match_exit_cycle): Rename collapse variable to count, + set it to orderedc if non-zero, instead of collapse. + * trans-decl.c (add_attributes_to_decl): Add "omp declare target link" + instead of "omp declare target" for omp_declare_target_link. + * trans-common.c (build_common_decl): Likewise. + * match.h (gfc_match_omp_target_enter_data, + gfc_match_omp_target_exit_data, gfc_match_omp_target_parallel, + gfc_match_omp_target_parallel_do, + gfc_match_omp_target_parallel_do_simd, gfc_match_omp_target_simd, + gfc_match_omp_taskloop, gfc_match_omp_taskloop_simd, + gfc_match_omp_end_critical, gfc_match_omp_ordered_depend): New + prototypes. + * parse.c (decode_omp_directive): Use gfc_match_omp_end_critical + instead of gfc_match_omp_critical for !$omp end critical. + Handle new OpenMP 4.5 constructs. If ordered directive has + depend clause as the first of the clauses, use + gfc_match_omp_ordered_depend and ST_OMP_ORDERED_DEPEND instead of + gfc_match_omp_ordered and ST_OMP_ORDERED. + (case_executable): Add ST_OMP_TARGET_ENTER_DATA, + ST_OMP_TARGET_EXIT_DATA and ST_OMP_ORDERED_DEPEND cases. + (case_exec_markers): Add ST_OMP_TARGET_PARALLEL, + ST_OMP_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, + ST_OMP_TARGET_SIMD, ST_OMP_TASKLOOP and ST_OMP_TASKLOOP_SIMD cases. + (gfc_ascii_statement): Handle new OpenMP 4.5 constructs. + (parse_omp_do): Handle ST_OMP_TARGET_PARALLEL_DO, + ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_TASKLOOP and + ST_OMP_TASKLOOP_SIMD. + (parse_omp_structured_block): Handle EXEC_OMP_END_CRITICAL instead + of EXEC_OMP_CRITICAL, adjust for EXEC_OMP_CRITICAL having omp clauses + now. + (parse_executable): Handle ST_OMP_TARGET_PARALLEL, + ST_OMP_TARGET_PARALLEL_DO, ST_OMP_TARGET_PARALLEL_DO_SIMD, + ST_OMP_TASKLOOP and ST_OMP_TASKLOOP_SIMD. + +2016-11-09 Mikael Morin <mikael@gcc.gnu.org> + Janus Weil <janus@gcc.gnu.org> + + PR fortran/46459 + * interface.c (compare_actual_formal): Add safety checks to avoid ICE. + +2016-11-09 Fritz O. Reese <fritzoreese@gmail.com> + + PR fortran/78259 + * trans-expr.c (gfc_trans_subcomponent_assign): Guard against NULL + values. + +2016-11-09 Steven G. Kargl <kargl@gcc.gnu.org> + Janus Weil <janus@gcc.gnu.org> + + PR fortran/60777 + * expr.c (external_spec_function): Allow recursive specification + functions in F03. + +2016-11-09 Paul Thomas <pault@gcc.gnu.org> + + * check.c (gfc_check_move_alloc): Prevent error that avoids + aliasing between to and from arguments from rejecting valid + code. + +2016-11-09 Janus Weil <janus@gcc.gnu.org> + + PR fortran/71894 + * class.c (gfc_add_component_ref): Add safety checks to avoid ICE. + +2016-11-08 Janus Weil <janus@gcc.gnu.org> + + PR fortran/68440 + * expr.c (check_alloc_comp_init): Loosen an assert. + * resolve.c (resolve_fl_parameter): Reject class parameters. + +2016-11-08 Janus Weil <janus@gcc.gnu.org> + + PR fortran/77596 + * expr.c (gfc_check_pointer_assign): Add special check for procedure- + pointer component with absent interface. + +2016-11-07 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78226 + * expr.c (gfc_generate_initializer): Add where to EXPR_NULL + statement. + * iresolve.c (gfc_resolve_extends_type_of): Add where to + both arguments of the function. + * resolve.c (resolve_select_type): Add where to the + second argument of the new statement. + +2016-11-07 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78226 + * match.c (gfc_match_select_type): Add where for expr1. + * resolve.c (resolev_select_type): Add where for expr1 of new + statement. + +2016-11-06 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78226 + resolve.c (build_loc_call): Add location to return value. + +2016-11-06 Andre Vehreschild <vehre@gcc.gnu.org> + + * expr.c (is_non_empty_structure_constructor): New function to detect + non-empty structure constructor. + (gfc_has_default_initializer): Analyse initializers. + * resolve.c (cond_init): Removed. + (resolve_allocate_expr): Removed dead code. Moved invariant code out + of the loop over all objects to allocate. + (resolve_allocate_deallocate): Added the invariant code remove from + resolve_allocate_expr. + * trans-array.c (gfc_array_allocate): Removed nullify of structure + components in favour of doing this in gfc_trans_allocate for both + scalars and arrays in the same place. + * trans-expr.c (gfc_trans_init_assign): Always using _vptr->copy for + class objects. + * trans-stmt.c (allocate_get_initializer): Get the initializer + expression for object allocated. + (gfc_trans_allocate): Nullify a derived type only, when no SOURCE= + or MOLD= is present preventing duplicate work. Moved the creation + of the init-expression here to prevent code for conditions that + can not occur on freshly allocated object, like checking for the need + to free allocatable components. + +2016-11-06 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78221 + * arith.c (gfc_complex2real): Change gfc_warning_now to + gfc_warning. + +2016-11-05 Paul Thomas <pault@gcc.gnu.org> + + * check.c (gfc_check_move_alloc): Introduce error to prevent + aliasing between to and from arguments. + +2016-11-05 Janus Weil <janus@gcc.gnu.org> + Manuel Lopez-Ibanez <manu@gcc.gnu.org> + + PR fortran/69495 + * invoke.texi: Mention -Wpedantic as an alias of -pedantic. + * check.c (gfc_check_transfer): Mention responsible flag in warning + message. + * frontend-passes.c (do_warn_function_elimination): Ditto. + * resolve.c (resolve_elemental_actual): Ditto. + (resolve_operator): Ditto. + (warn_unused_fortran_label): Ditto. + * trans-common.c (translate_common): Ditto. + +2016-11-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/67564 + * trans-expr.c (gfc_conv_class_to_class): Return _len component + of unlimited polymorphic entities. + +2016-11-04 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/64933 + * primary.c (gfc_match_varspec): If selector expression is + unambiguously an array, make sure that the associate name + is an array and has an array spec. Modify the original + condition for doing this to exclude character types. + +2016-11-03 Fritz Reese <fritzoreese@gmail.com> + + * gfortran.texi: Document. + * gfortran.h (gfc_dt): New field default_exp. + * primary.c (match_real_constant): Default exponent with -fdec. + * io.c (match_io): Set dt.default_exp with -fdec. + * ioparm.def (IOPARM_dt_default_exp): New. + * trans-io.c (build_dt): Set IOPARM_dt_default_exp with -fdec. + +2016-11-03 Fritz O. Reese <fritzoreese@gmail.com> + + * decl.c (gfc_match_parameter): Allow omitted '()' with -std=legacy. + * parse.c (decode_statement): Match "parameter" before assignments. + * gfortran.texi: Document. + +2016-11-02 Fritz O. Reese <fritzoreese@gmail.com> + + * lang.opt, invoke.texi: New argument -Wargument-mismatch. + * interface.c (compare_parameter, compare_actual_formal, + gfc_check_typebound_override, argument_rank_mismatch): Control argument + mismatch warnings with -Wargument-mismatch. + * resolve.c (resolve_structure_cons, resolve_global_procedure): Ditto. + +2016-11-02 Fritz Reese <fritzoreese@gmail.com> + + * gfortran.h (gfc_error): New declaration for gfc_error with 'opt'. + * error.c (gfc_error): Add optional 'opt' argument. + * error.c (gfc_notify_std): Call fully-qualified gfc_error. + +2016-11-01 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78178 + * match.c (match_simple_where): Fill in locus for assigment + in simple WHERE statement. + +2016-11-01 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/69544 + * match.c (gfc_match_where): Fill in locus for assigment + in simple WHERE statement. + +2016-10-31 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/54679 + * io.c (check_format): Adjust checks for FMT_L to treat a zero + width as an extension, giving warnings or error as appropriate. + Improve messages. + +2016-10-31 Jakub Jelinek <jakub@redhat.com> + + * trans-types.c (gfc_get_array_descr_info): For -gdwarf-5 or + -gno-strict-dwarf, handle assumed rank arrays the way dwarf2out + expects. + +2016-10-30 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/67219 + * arith.c (gfc_int2real): Change gfc_warning_now + to gfc_warning. + * primary.c (match_complex_constant): If there + is no comma, throw away any warning which might have + been issued by gfc_int2real. + +2016-10-28 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/71891 + * symbol.c (gfc_type_compatible): Fix typo. + +2016-10-27 Jakub Jelinek <jakub@redhat.com> + + PR fortran/78026 + * parse.c (decode_statement): Don't create namespace for possible + select type here and destroy it afterwards. + (parse_select_type_block): Set gfc_current_ns to new_st.ext.block.ns. + (parse_executable, gfc_parse_file): Formatting fixes. + * match.c (gfc_match_select_type): Create namespace for select type + here, only after matching select type. Formatting fixes. Free that + namespace if not returning MATCH_YES, after gfc_undo_symbols, + otherwise remember it in new_st.ext.block.ns and switch to parent + namespace anyway. + +2016-10-27 Fritz Reese <fritzoreese@gmail.com> + + * expr.c (generate_union_initializer, get_union_initializer): New. + * expr.c (component_initializer): Consider BT_UNION specially. + * resolve.c (resolve_structure_cons): Hack for BT_UNION. + * trans-expr.c (gfc_trans_subcomponent_assign): Ditto. + * trans-expr.c (gfc_conv_union_initializer): New. + * trans-expr.c (gfc_conv_structure): Replace UNION handling code with + new function gfc_conv_union_initializer. + +2016-10-26 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/78092 + * trans-intrinsic.c (gfc_conv_intrinsic_sizeof): Fix reference to an + array element of type CLASS. + +2016-10-26 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/78108 + * resolve.c (resolve_typebound_intrinsic_op): For submodules + suppress the error and return if the same procedure symbol + is added more than once to the interface. + +2016-10-26 Fritz Reese <fritzoreese@gmail.com> + + * frontend-passes.c (gfc_code_walker): Add SHARE and CARRIAGECONTROL. + * io.c (gfc_free_open, gfc_resolve_open, gfc_match_open): Ditto. + * gfortran.h (gfc_open): Add SHARE, CARRIAGECONTROL, and READONLY. + * io.c (io_tag, match_open_element): Ditto. + * ioparm.def: Ditto. + * trans-io.c (gfc_trans_open): Ditto. + * io.c (match_dec_etag, match_dec_ftag): New functions. + * gfortran.texi: Document. + +2016-10-25 Fritz Reese <fritzoreese@gmail.com> + + * gfortran.texi: Document. + * resolve.c (logical_to_bitwise): New function. + * resolve.c (resolve_operator): Wrap operands with logical_to_bitwise. + +2016-10-25 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/72770 + * class.c (find_intrinsic_vtab): No longer encode the string length + into vtype's name and use the char's kind for the size instead of + the string_length time the size. + * trans-array.c (gfc_conv_ss_descriptor): For deferred length char + arrays the dynamically sized type needs to be declared. + (build_class_array_ref): Address the i-th array element by multiplying + it with the _vptr->_size and the _len to make sure char arrays are + addressed correctly. + * trans-expr.c (gfc_conv_intrinsic_to_class): Made comment more + precise. + +2016-10-25 Cesar Philippidis <cesar@codesourcery.com> + + * intrinsic.texi (cosd): New mathop. + +2016-10-25 Fritz Reese <fritzoreese@gmail.com> + + * match.c (gfc_match_intrinsic_op): Match ".XOR." with -std=legacy. + * gfortran.texi: Document. + +2016-10-25 Fritz Reese <fritzoreese@gmail.com> + + * primary.c (gfc_match_rvalue): Match %LOC as LOC with -std=legacy. + * gfortran.texi: Document. + +2016-10-25 Fritz Reese <fritzoreese@gmail.com> + + * decl.c (gfc_match_type): New function. + * match.h (gfc_match_type): New function. + * match.c (gfc_match_if): Special case for one-line IFs. + * gfortran.texi: Update documentation. + * parse.c (decode_statement): Invoke gfc_match_type. + +2016-10-25 Fritz Reese <fritzoreese@gmail.com> + + * gfortran.texi: Document. + * gfortran.h (gfc_is_whitespace): Include form feed ('\f'). + +2016-10-25 Fritz Reese <fritzoreese@gmail.com> + + * invoke.texi, gfortran.texi: Touch up documentation of -fdec. + * gfortran.h (gfc_option): Move flag_dec_structure out of gfc_option. + * decl.c (match_record_decl, gfc_match_decl_type_spec, + gfc_match_structure_decl): Ditto. + * match.c (gfc_match_member_sep): Ditto. + * options.c (gfc_handle_option): Ditto. + * lang.opt (fdec-structure): Use Fortran Var for flag_dec_structure. + * lang.opt (fdec): Use Fortran Var to create flag_dec. + * options.c (set_dec_flags): With -fdec enable -fcray-pointer, + -fd-lines-as-comments (default), -fdollar-ok, and legacy std flags. + +2016-10-24 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/77828 + * ioparm.def: Reorder dt parameters to match libgfortran. + * libgfortran.h: Swap definitions of GFC_INTERNAL_UNIT and + GFC_INTERNAL_UNIT4. + +2016-10-24 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/71895 + * interface.c (gfc_compare_derived_types): Convert gcc_assert() + to a gfc_internal_error() to prevent an ICE. + +2016-10-24 Jakub Jelinek <jakub@redhat.com> + + * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Use VAR_P (x) + instead of TREE_CODE (x) == VAR_DECL. + * trans-expr.c (gfc_class_vptr_get, gfc_class_len_get, + gfc_class_len_or_zero_get, gfc_get_vptr_from_expr, + gfc_conv_string_length, conv_base_obj_fcn_val, + gfc_conv_procedure_call, gfc_trans_assignment_1): Likewise. + * trans-openmp.c (gfc_omp_predetermined_sharing, + gfc_omp_disregard_value_expr, gfc_omp_private_debug_clause, + gfc_trans_omp_atomic, gfc_trans_omp_do): Likewise. + * trans-io.c (nml_get_addr_expr): Likewise. + * trans-decl.c (gfc_finish_decl, gfc_build_qualified_array, + gfc_get_symbol_decl, gfc_get_fake_result_decl, + gfc_trans_deferred_vars, gfc_trans_use_stmts, + generate_local_decl): Likewise. + * trans-array.c (trans_array_constructor, trans_array_bound_check, + build_class_array_ref, gfc_array_init_size, + gfc_trans_auto_array_allocation, gfc_trans_g77_array, + gfc_trans_dummy_array_bias, gfc_alloc_allocatable_for_assignment, + gfc_trans_deferred_array): Likewise. + * trans.c (gfc_build_array_ref): Likewise. Use + VAR_OR_FUNCTION_DECL_P (x) instead of TREE_CODE (x) == VAR_DECL + || TREE_CODE (x) == FUNCTION_DECL. + +2016-10-23 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77763 + * parse.c (parse_spec): Allow STRUCTURE in BLOCK DATA. Sort + case labels. + +2016-10-23 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/54730 + PR fortran/78033 + * array.c (gfc_match_array_constructor): Remove checkpointing + introduced in r196416 (original fix for PR fortran/54730). Move + initialization to top of function. + * match.c (gfc_match_type_spec): Special case matching for REAL. + +2016-10-23 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/69834 + * class.c (gfc_find_derived_vtab): Obtain the gsymbol for the + derived type's module. If the gsymbol is present and the top + level namespace corresponds to a module, use the gsymbol name + space. In the search to see if the vtable exists, try the gsym + namespace first. + * dump-parse-tree (show_code_node): Modify select case dump to + show select type construct. + * resolve.c (build_loc_call): New function. + (resolve_select_type): Add check for repeated type is cases. + Retain selector expression and use it later instead of expr1. + Exclude deferred length TYPE IS cases and emit error message. + Store the address for the vtable in the 'low' expression and + the hash value in the 'high' expression, for each case. Do not + call resolve_select. + * trans.c(trans_code) : Call gfc_trans_select_type. + * trans-stmt.c (gfc_trans_select_type_cases): New function. + (gfc_trans_select_type): New function. + * trans-stmt.h : Add prototype for gfc_trans_select_type. + +2016-10-22 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/78021 + * gfc_compare_functions: Strings with different lengths in + argument lists compare unequal. + +2016-10-22 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/43366 + PR fortran/51864 + PR fortran/57117 + PR fortran/61337 + PR fortran/61376 + * primary.c (gfc_expr_attr): For transformational functions on classes + get the attrs from the class argument. + * resolve.c (resolve_ordinary_assign): Remove error message due to + feature implementation. Rewrite POINTER_ASSIGNS to ordinary ones when + the right-hand side is scalar class object (with some restrictions). + * trans-array.c (trans_array_constructor): Create the temporary from + class' inner type, i.e., the derived type. + (build_class_array_ref): Add support for class array's storage of the + class object or the array descriptor in the decl saved descriptor. + (gfc_conv_expr_descriptor): When creating temporaries for class objects + add the class object's handle into the decl saved descriptor. + (structure_alloc_comps): Use the common way to get the _data component. + (gfc_is_reallocatable_lhs): Add notion of allocatable class objects. + * trans-expr.c (gfc_find_and_cut_at_last_class_ref): Remove the only ref + only when the expression's type is BT_CLASS. + (gfc_trans_class_init_assign): Correctly handle class arrays. + (gfc_trans_class_assign): Joined into gfc_trans_assignment_1. + (gfc_conv_procedure_call): Support for class types as arguments. + (trans_get_upoly_len): For unlimited polymorphics retrieve the _len + component's tree. + (trans_class_vptr_len_assignment): Catch all ways to assign the _vptr + and _len components of a class object correctly. + (pointer_assignment_is_proc_pointer): Identify assignments of + procedure pointers. + (gfc_trans_pointer_assignment): Enhance support for class object pointer + assignments. + (gfc_trans_scalar_assign): Removed assert. + (trans_class_assignment): Assign to a class object. + (gfc_trans_assignment_1): Treat class objects correctly. + (gfc_trans_assignment): Propagate flags to trans_assignment_1. + * trans-stmt.c (gfc_trans_allocate): Use gfc_trans_assignment now + instead of copy_class_to_class. + * trans-stmt.h: Function prototype removed. + * trans.c (trans_code): Less special casing for class objects. + * trans.h: Added flags to gfc_trans_assignment () prototype. + +2016-10-21 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/69566 + * resolve.c (fixup_array_ref): New function. + (resolve_select_type): Gather up the rank and array reference, + if any, from the selector. Fix up the 'associate name' and the + 'associate entities' as necessary. + * trans-expr.c (gfc_conv_class_to_class): If the symbol backend + decl is a FUNCTION_DECL, use the 'fake_result_decl' instead. + +2016-10-20 Steven G. Kargl <kargl@gcc.gnu.org> + + * array.c (gfc_match_array_constructor): Remove set, but unused + variable. + +2016-10-20 Andre Vehreschild <vehre@gcc.gnu.org> + + * class.c (gfc_build_class_symbol): Set the kind of _len to + gfc_charlen_int_kind to catch changes of the charlen kind. + +2016-10-17 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77978 + * match.c (gfc_match_stopcode): Fix error reporting for several + deficiencies in matching stop-codes. + +2016-10-17 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/61420 + PR fortran/78013 + * resolve.c (resolve_variable): Obtain the typespec for a + variable expression, when the variable is a function result + that is a procedure pointer. + +2016-10-16 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/48298 + * trans-io.c (transfer_expr): Ignore dtio procedures for inquire + with iolength. + +2016-10-15 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/77972 + * scanner.c (gfc_next_char_literal): If nextc is null do not + decrement the pointer and call the diagnostics. + +2016-10-14 Andre Vehreschild <vehre@gcc.gnu.org> + + * resolve.c (resolve_symbol): Add unimplemented message for + polymorphic types with allocatable/pointer components and coarray=lib. + +2016-10-13 Thomas Preud'homme <thomas.preudhomme@arm.com> + + * trans-intrinsic.c: Include memmodel.h. + +2016-10-13 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/72832 + * trans-expr.c (gfc_copy_class_to_class): Add generation of + runtime array bounds check. + * trans-intrinsic.c (gfc_conv_intrinsic_size): Add a crutch to + get the descriptor of a function returning a class object. + * trans-stmt.c (gfc_trans_allocate): Use the array spec on the + array to allocate instead of the array spec from source=. + +2016-10-12 Andre Vehreschild <vehre@gcc.gnu.org> + + * trans-expr.c (gfc_find_and_cut_at_last_class_ref): Fixed style. + (gfc_trans_class_init_assign): Same. + (gfc_conv_procedure_call): Same. + (gfc_trans_assignment_1): Same. + * trans-stmt.c (gfc_trans_allocate): Same. + +2016-10-11 Jakub Jelinek <jakub@redhat.com> + + * iresolve.c (is_trig_resolved, resolve_trig_call): Formatting fixes. + * simplify.c (simplify_trig_call, degrees_f, radians_f, + gfc_simplify_atrigd, gfc_simplify_cotan): Likewise. + +2016-10-11 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77942 + * simplify.c (gfc_simplify_cshift): Check for zero. + +2016-10-11 Fritz Reese <fritzoreese@gmail.com> + + * iresolve.c (get_radians, get_degrees): Fix sloppy commit. + * simplify.c (degrees_f, radians_f): Ditto. + +2016-10-11 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + * simplify.c (radians_f): Fix mpfr_mod. + * ireolce.c (get_degrees): Declare tmp. + +2016-10-11 Fritz Reese <fritzoreese@gmail.com> + + * lang.opt: New flag -fdec-math. + * options.c (set_dec_flags): Enable with -fdec. + * invoke.texi, gfortran.texi, intrinsic.texi: Update documentation. + * intrinsics.c (add_functions, do_simplify): New intrinsics + with -fdec-math. + * gfortran.h (gfc_isym_id): New isym GFC_ISYM_COTAN. + * gfortran.h (gfc_resolve_atan2d, gfc_resolve_cotan, + gfc_resolve_trigd, gfc_resolve_atrigd): New prototypes. + * iresolve.c (resolve_trig_call, get_degrees, get_radians, + is_trig_resolved, gfc_resolve_cotan, gfc_resolve_trigd, + gfc_resolve_atrigd, gfc_resolve_atan2d): New functions. + * intrinsics.h (gfc_simplify_atan2d, gfc_simplify_atrigd, + gfc_simplify_cotan, gfc_simplify_trigd): New prototypes. + * simplify.c (simplify_trig_call, degrees_f, radians_f, + gfc_simplify_cotan, gfc_simplify_trigd, gfc_simplify_atrigd, + gfc_simplify_atan2d): New functions. + +2016-10-10 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/77915 + * frontend-passes.c (inline_matmul_assign): Return early if + inside a FORALL statement. + +2016-10-07 Fritz Reese <fritzoreese@gmail.com> + + * interface.c (compare_components): Check charlen for BT_CHAR. + +2016-10-07 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77406 + * interface.c (gfc_compare_interfaces): Fix detection of ambiguous + interface involving alternate return. + (check_interface1): Improve error message and loci. + +2016-10-06 Louis Krupp <louis.krupp@zoho.com> + + PR fortran/69955 + * trans-array.c (gfc_conv_expr_descriptor): Don't allocate + components if it's not necessary. + +2016-10-05 Louis Krupp <louis.krupp@zoho.com> + + PR fortran/57910 + * trans-expr.c (gfc_add_interface_mapping): Don't try to + dereference call-by-value scalar argument. + +2016-10-05 Steven G. Kargl <kargls@gcc.gnu.org> + + PR fortran/58991 + PR fortran/58992 + * resolve.c (resolve_assoc_var): Fix CHARACTER type-spec for a + selector in ASSOCIATE. + (resolve_fl_variable): Skip checks for an ASSOCIATE variable. + +2016-10-05 Fritz Reese <fritzoreese@gmail.com> + + * interface.c (gfc_compare_types): Don't compare BT_UNION components + until we know they're both UNIONs. + * interface.c (gfc_compare_union_types): Guard against empty + components. + +2016-10-05 Louis Krupp <louis.krupp@zoho.com> + + PR fortran/67524 + * resolve.c (resolve_symbol): Don't apply default type rules to + mixed-entry master created for function entry points. + +2016-09-30 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/66643 + * io.c (match_dt_unit): Peek check for missing format. + +2016-09-30 Fritz Reese <fritzoreese@gmail.com> + + PR fortran/77764 + * interface.c (gfc_compare_union_types): Null-guard map components. + +2016-09-30 Fritz Reese <fritzoreese@gmail.com> + + PR fortran/77782 + * interface.c (gfc_compare_derived_types): Use gfc_compare_union_types + to compare union types. + +2016-09-30 Andre Vehreschild <vehre@gcc.gnu.org> + + * trans-array.c (gfc_array_allocate): Use the token from coarray's + .token member. + * trans-intrinsic.c (conv_expr_ref_to_caf_ref): Only generate + caf-reference chains from the first coarray references on. + * trans-types.c (gfc_get_derived_type): Switch on mandatory .token + member generation for allocatable arrays in coarrays in derived types. + +2016-09-29 James Greenhalgh <james.greenhalgh@arm.com> + + * options.c (gfc_post_options): Remove special case for + TARGET_FLT_EVAL_METHOD_NON_DEFAULT with -fexcess-precision=standard. + +2016-09-27 Jakub Jelinek <jakub@redhat.com> + + * dependency.c (gfc_dep_compare_expr): Remove break after return. + * frontend-passes.c (optimize_op): Likewise. + * interface.c (gfc_current_interface_head): Likewise. + * symbol.c (check_conflict): Likewise. + * trans-intrinsic.c (build_fix_expr): Likewise. + + PR fortran/77666 + * trans-openmp.c (gfc_omp_private_outer_ref): Return true even for + references to allocatable arrays. + +2016-09-26 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77420 + * trans-common.c: Handle array elements in equivalence when + the lower and upper bounds of array spec are NULL. + +2016-09-26 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/48298 + * interface.c (gfc_find_specific_dtio_proc) : Return NULL if + the derived type is broken, as indicated by a flavor other than + FL_DERIVED. + +2016-09-26 Marek Polacek <polacek@redhat.com> + + PR c/7652 + * arith.c (eval_intrinsic): Add gcc_fallthrough. + * frontend-passes.c (optimize_op): Likewise. + (gfc_expr_walker): Likewise. + * parse.c (next_fixed): Likewise. + * primary.c (match_variable): Likewise. + * trans-array.c: Likewise. + * trans-expr.c (flatten_array_ctors_without_strlen): Likewise. + * trans-io.c (transfer_expr): Likewise. + +2016-09-25 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77429 + * dependency.c (gfc_check_dependency): Convert gcc_assert() to + a conditional and possible call to gfc_internal_error(). + +2016-09-25 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77694 + * frontend-passes.c (optimize_binop_array_assignment): Check pointer + for NULL. + +2016-09-23 Fritz Reese <fritzoreese@gmail.com> + + * lang.opt, invoke.texi, gfortran.texi: New flag -fdec-static. + * options.c (set_dec_flags): Set -fdec-static with -fdec. + * gfortran.h (symbol_attribute): New attribute automatic. + * gfortran.h (gfc_add_automatic): New prototype. + * match.h (gfc_match_automatic, gfc_match_static): New functions. + * decl.c (gfc_match_automatic, gfc_match_static): Ditto. + * symbol.c (gfc_add_automatic): Ditto. + * decl.c (match_attr_spec): Match AUTOMATIC and STATIC decls. + * parse.c (decode_specification_statement, decode_statement): Ditto. + * resolve.c (apply_default_init_local, resolve_fl_variable_derived, + resolve_symbol): Support for automatic attribute. + * symbol.c (check_conflict, gfc_copy_attr, gfc_is_var_automatic): + Ditto. + * trans-decl.c (gfc_finish_var_decl): Ditto. + +2016-09-23 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/48298 + * gfortran.h (gfc_dt): Add *udtio. + * ioparm.def: Add bit IOPARM_dt_f2003 to align with library use of bit + 25. Add IOPARM_dt_dtio bit to common flags. + * resolve.c (resolve_transfer): Set dt->udtio to expression. + * io.c (gfc_match_inquire): Adjust error message for internal + unit KIND. + * libgfortran.h: Adjust defines for GFC_INTERNAL_UNIT4, + GFC_INTERNAL_UNIT, and GFC_INVALID_UNIT. + * trans-io.c (build_dt): Set common_unit to reflect the KIND of + the internal unit. Set mask bit for presence of dt->udtio. + +2016-09-22 Andre Vehreschild <vehre@gcc.gnu.org> + + * trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Use the old caf- + interface where possible. + +2016-09-22 Paul Thomas <pault@gcc.gnu.org> + + * interface.c (check_dtio_interface1): Introduce errors for + alternate returns and incorrect numbers of arguments. + (gfc_find_specific_dtio_proc): Return cleanly if the derived + type either doesn't exist or has no namespace. + +2016-09-21 Louis Krupp <louis.krupp@zoho.com> + + PR fortran/66107 + * decl.c (add_init_expr_to_sym): Catch variable character length + in parameter array. + +2016-09-21 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/77657 + + * interface.c (gfc_find_specific_dtio_proc): Borrow trick from + resolve_typebound_generic_call to find dtio procedures that + over-ride those in the declared type. + +2016-09-20 Marek Polacek <polacek@redhat.com> + + * trans-intrinsic.c (conv_expr_ref_to_caf_ref): Adjust fall through + comment. + +2016-09-19 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/71952 + * expr.c (gfc_check_assign): Added flag to control whether datatype + conversion is allowed. + * gfortran.h: Added caf-token-tree to gfc_component. Changed + prototypes mostly to add whether datatype conversion is allowed. + * gfortran.texi: Added documentation for the caf_reference_t and the + caf_*_by_ref function. + * primary.c (caf_variable_attr): Similar to gfc_variable_attr but + focused on the needs of coarrays. + (gfc_caf_attr): Same. + * resolve.c (resolve_ordinary_assign): Set the conversion allowed + flag when not in a coarray. + * trans-array.c (gfc_array_init_size): Moved setting of array + descriptor's datatype before the alloc, because caf_register needs it. + (gfc_array_allocate): Changed notion of whether an array is a coarray. + (gfc_array_deallocate): Same. + (gfc_alloc_allocatable_for_assignment): Added setting of coarray's + array descriptor datatype before the register. And using deregister/ + register to mimmick a realloc for coarrays. + * trans-decl.c (gfc_build_builtin_function_decls): Corrected signatures + of old caf-functions and added signature definitions of the _by_ref + ones. + (generate_coarray_sym_init): Adapted to new caf_register signature. + * trans-expr.c (gfc_conv_scalar_to_descriptor): Make sure a constant + is translated to an lvalue expression before use in an array + descriptor. + (gfc_get_ultimate_alloc_ptr_comps_caf_token): New function. Get the + last allocatable component's coarray token. + (gfc_get_tree_for_caf_expr): For top-level object get the coarray + token and check for unsupported features. + (gfc_get_caf_token_offset): Getting the offset might procude new + statements, which now are stored in the pre and post of the current se. + (gfc_caf_get_image_index): For this image return a call to + caf_this_image. + (expr_may_alias_variables): Check that the result is set for testing + its properties. + (alloc_scalar_allocatable_for_assignment): Added auto allocation of + coarray components. + (gfc_trans_assignment_1): Rewrite an assign to a coarray object to + be a sendget. + * trans-intrinsic.c (conv_caf_vector_subscript_elem): Corrected + wrong comment. + (compute_component_offset): Compute the correct offset a structure + member. + (conv_expr_ref_to_caf_ref): Convert to a chain of refs into + caf_references. + (gfc_conv_intrinsic_caf_get): Call caf_get_by_ref instead of caf_get. + (conv_caf_send): Call caf_*_by_ref for coarrays that need + reallocation. + (gfc_conv_intrinsic_function): Adapted to new signuature of the caf + drivers. + (conv_intrinsic_atomic_op): Add pre and post statements correctly. + (conv_intrinsic_atomic_ref): Same. + (conv_intrinsic_atomic_cas): Same. + (conv_intrinsic_event_query): Same. + * trans-stmt.c (gfc_trans_lock_unlock): Same. + (gfc_trans_event_post_wait): Same. + (gfc_trans_allocate): Support allocation of allocatable coarrays. + (gfc_trans_deallocate): And there deallocation. + * trans-types.c (gfc_typenode_for_spec): Added flag to control whether + a component is part of coarray. When so, then add space to store a + coarray token. + (gfc_build_array_type): Same. + (gfc_get_array_descriptor_base): Same. + (gfc_get_array_type_bounds): Same. + (gfc_sym_type): Same. + (gfc_get_derived_type): Same. + (gfc_get_caf_reference_type): Declare the caf_reference_type. + * trans-types.h: Prototype changes only. + * trans.c (gfc_allocate_using_lib): Use the updated caf_register + signature. + (gfc_allocate_allocatable): Same. + (gfc_deallocate_with_status): Same. + * trans.h: Defined the runtime types for caf_reference_t and the enums. + +2016-09-19 Fritz Reese <fritzoreese@gmail.com> + + PR fortran/77584 + * decl.c (match_record_decl, gfc_match_decl_type_spec): Fixes to + handling of structure/record from declaration-type-spec. + +2016_09_17 Louis Krupp <louis.krupp@zoho.com> + + PR fortran/68078 + * resolve.c (resolve_allocate_expr): Check that derived type + pointer, object or array has been successfully allocated before + initializing. + +2016-09-16 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77612 + * decl.c (char_len_param_value): Check parent namespace for + seen_implicit_none. + +2016-09-15 Louis Krupp <louis.krupp@zoho.com> + + PR fortran/69963 + * parse.c (reject_statement): Clear charlen pointers in implicit + character typespecs before those charlen structures are freed. + +2016-09-14 Bernd Edlinger <bernd.edlinger@hotmail.de> + + * simplify.c (gfc_simplify_repeat): Fix a misplaced closing ')'. + +2016-09-13 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77420 + * module.c (load_equiv): Revert revision 240063. + +2016-09-10 Paul Thomas <pault@gcc.gnu.org> + Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77532 + * interface.c (check_dtio_arg_TKR_intent): Return after error. + (check_dtio_interface1): Remove asserts, test for NULL and return + if found. + +2016-09-09 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77420 + * module.c (load_equiv): If the current namespace has a list of + equivalence statements, initialize duplicate to false and then + look for duplicates; otherwise, initialize it to true. + +2016-09-09 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77506 + * array.c (gfc_match_array_constructor): CHARACTER(len=*) cannot + appear in an array constructor. + +2016-09-09 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77507 + * intrinsic.c (add_functions): Use correct keyword. + +2016-09-08 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/69514 + * array.c (gfc_match_array_constructor): If type-spec is present, + walk the array constructor performing possible conversions for + numeric types. + +2016-09-08 Jakub Jelinek <jakub@redhat.com> + + PR fortran/77500 + * trans-openmp.c (gfc_trans_omp_atomic): For atomic write or + swap, don't try to look through GFC_ISYM_CONVERSION. In other cases, + check that value.function.isym is non-NULL before dereferencing it. + +2016-09-04 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77391 + * resolve.c (deferred_requirements): New function to check F2008:C402. + (resolve_fl_variable,resolve_fl_parameter): Use it. + +2016-09-04 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77460 + * simplify.c (simplify_transformation_to_scalar): On error, result + may be NULL, simply return. + +2016-08-31 Jakub Jelinek <jakub@redhat.com> + + PR fortran/77352 + * trans-openmp.c (gfc_trans_omp_parallel_workshare): Always add a + BIND_EXPR with BLOCK around what gfc_trans_omp_workshare returns. + + PR fortran/77374 + * parse.c (parse_omp_oacc_atomic): Copy over cp->ext.omp_atomic + to cp->block->ext.omp_atomic. + * resolve.c (gfc_resolve_blocks): Assert block with one or two + EXEC_ASSIGNs for EXEC_*_ATOMIC. + * openmp.c (resolve_omp_atomic): Don't assert one or two + EXEC_ASSIGNs, instead return quietly for EXEC_NOPs and otherwise + error unexpected statements. + +2016-08-31 Paul Thomas <pault@gcc.gnu.org> + Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/48298 + * decl.c (access_attr_decl): Include case INTERFACE_DTIO as + appropriate. + * gfortran.h : Add INTRINSIC_FORMATTED and + INTRINSIC_UNFORMATTED to gfc_intrinsic_op. Add INTERFACE_DTIO + to interface type. Add new enum 'dtio_codes'. Add bitfield + 'has_dtio_procs' to symbol_attr. Add prototypes + 'gfc_check_dtio_interfaces' and 'gfc_find_specific_dtio_proc'. + * interface.c (dtio_op): New function. + (gfc_match_generic_spec): Match generic DTIO interfaces. + (gfc_match_interface): Treat DTIO interfaces in the same way as + (gfc_current_interface_head): Add INTERFACE_DTIO appropriately. + (check_dtio_arg_TKR_intent): New function. + (check_dtio_interface1): New function. + (gfc_check_dtio_interfaces): New function. + (gfc_find_specific_dtio_proc): New function. + * io.c : Add FMT_DT to format_token. + (format_lex): Handle DTIO formatting. + * match.c (gfc_op2string): Add DTIO operators. + * resolve.c (derived_inaccessible): Ignore pointer components + to enclosing derived type. + (resolve_transfer): Resolve transfers that involve DTIO. + procedures. Find the specific subroutine for the transfer and + use its existence to over-ride some of the constraints on + derived types. If the transfer is recursive, require that the + subroutine be so qualified. + (dtio_procs_present): New function. + (resolve_fl_namelist): Remove inhibition of polymorphic objects + in namelists if DTIO read and write subroutines exist. Likewise + for derived types. + (resolve_types): Invoke 'gfc_verify_dtio_procedures'. + * symbol.c : Set 'dtio_procs' using 'minit'. + * trans-decl.c (gfc_finish_var_decl): If a derived-type/class + object is associated with DTIO procedures, make it TREE_STATIC. + * trans-expr.c (gfc_get_vptr_from_expr): If the expression + drills down to a PARM_DECL, extract the vptr correctly. + (gfc_conv_derived_to_class): Check 'info' in the test for + 'useflags'. If the se expression exists and is a pointer, use + it as the class _data. + * trans-io.c : Add IOCALL_X_DERIVED to iocall and the function + prototype. Likewise for IOCALL_SET_NML_DTIO_VAL. + (set_parameter_tree): Renamed from 'set_parameter_const', now + returns void and has new tree argument. Calls modified to match + new interface. + (transfer_namelist_element): Transfer DTIO procedure pointer + and vpointer using the new function IOCALL_SET_NML_DTIO_VAL. + (get_dtio_proc): New function. + (transfer_expr): Add new argument for the vptr field of class + objects. Add the code to call the specific DTIO proc, convert + derived types to class and call IOCALL_X_DERIVED. + (trans_transfer): Add BT_CLASS to structures for treatment by + the scalarizer. Obtain the vptr for the dynamic type, both for + scalar and array transfer. + +2016-08-30 Fritz Reese <fritzoreese@gmail.com> + + * gfortran.texi: Fix typo in STRUCTURE documentation. + +2016-08-29 Fritz Reese <fritzoreese@gmail.com> + + Fix, reorganize, and clarify comparisons of anonymous types/components. + + PR fortran/77327 + * interface.c (is_anonymous_component, is_anonymous_dt): New functions. + * interface.c (compare_components, gfc_compare_derived_types): Use new + functions. + +2016-08-27 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77380 + * dependency.c (gfc_check_dependency): Do not assert with + -fcoarray=lib. + +2016-08-27 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77372 + simplify.c (simplify_ieee_selected_real_kind): Check for NULL pointers. + +2016-08-25 Steven g. Kargl <kargl@gcc.gnu.org> + + PR fortran/77351 + * frontend-passes.c (remove_trim,combine_array_constructor): Check for + NULL pointer. + +2016-08-24 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/77358 + * resolve.c (resolve_fl_procedure): Use the correct gfc_charlen + for deferred character length module procedures. + +2016-08-23 Fritz Reese <fritzoreese@gmail.com> + + * decl.c (gfc_match_structure_decl): Make gfc_structure_id static. + +2016-08-23 Fritz Reese <fritzoreese@gmail.com> + + * interface.c (compare_components): Fix typo in name check conditional. + +2016-08-22 Steven G. Kargl <kargl@gcc.gnu.org> + Bud Davis <jmdavis@link.com> + + PR fortran/60774 + * parse.c (next_free,next_fixed): Issue error for statement label + without a statement. + +2016-08-22 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/61318 + * interface.c (compare_parameter): Use better locus for error message. + +2016-08-22 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/77260 + * gcc/fortran/trans-decl.c (generate_local_decl): Suppress warning + for unused variable if symbol is entry point. + +2016-08-19 Joseph Myers <joseph@codesourcery.com> + + PR c/32187 + * trans-types.h (float128_type_node): Rename to + gfc_float128_type_node. + (complex_float128_type_node): Rename to + gfc_complex_float128_type_node. + * iso-c-binding.def, trans-intrinsic.c, trans-types.c: All users + changed. + +2016-08-19 Jakub Jelinek <jakub@redhat.com> + + PR fortran/71014 + * resolve.c (gfc_resolve): For ns->construct_entities don't save, clear + and restore omp state around the resolving. + + PR fortran/69281 + * trans-openmp.c (gfc_trans_omp_parallel, gfc_trans_omp_task, + gfc_trans_omp_target): Wrap gfc_trans_omp_code result in an extra + BIND_EXPR with its own forced BLOCK. + +2016-08-19 Janne Blomqvist <jb@gcc.gnu.org> + + * intrinsics.texi (RANDOM_NUMBER): Remove reference to + init_random_seed in example. + (RANDOM_SEED): Remove warning to not set all seed values to 0. + +2016-08-18 David Malcolm <dmalcolm@redhat.com> + + * error.c (gfc_diagnostic_starter): Update for change to + diagnostic_show_locus. + +2016-08-17 Jakub Jelinek <jakub@redhat.com> + + PR fortran/67496 + * trans-array.c (trans_array_constructor): Load + expr->ts.u.cl->length_from_typespec only if expr->ts.type is + BT_CHARACTER. + +2016-08-15 Fritz Reese <fritzoreese@gmail.com> + + * lang.opt, invoke.texi: New flag -finit-derived. + * gfortran.h (gfc_build_default_init_expr, gfc_apply_init, + gfc_generate_initializer): New prototypes. + * expr.c (gfc_build_default_init_expr, gfc_apply_init, + component_initializer, gfc_generate_initializer): New functions. + * expr.c (gfc_default_initializer): Wrap gfc_generate_initializer. + * decl.c (build_struct): Move common code to gfc_apply_init. + * resolve.c (can_generate_init): New function. + * resolve.c (build_default_init_expr): Wrap gfc_build_default_init_expr. + * resolve.c (apply_default_init, resolve_fl_variable_derived): Use + gfc_generate_initializer. + * trans-decl.c (gfc_generate_function_code): Use + gfc_generate_initializer. + +2016-08-15 Thomas Koenig <tkoenig@gcc.gnu.org> + + * frontend-passes.c (create_var): Set ts.deferred for + deferred-length character variables. + * dump-parse-tree.c (show_typespec): Also dump + is_c_interop, is_iso_c and deferred flags. + +2016-08-15 Jakub Jelinek <jakub@redhat.com> + + PR debug/71906 + * trans-decl.c (gfc_get_symbol_decl): Call gfc_finish_var_decl + for decl's character length before gfc_finish_var_decl on the + decl itself. + +2016-08-14 Chung-Lin Tang <cltang@codesourcery.com> + + PR fortran/70598 + * openmp.c (resolve_omp_clauses): Adjust use_device clause + handling to only allow pointers and arrays. + +2016-08-12 Marek Polacek <polacek@redhat.com> + + PR c/7652 + * decl.c (match_attr_spec): Add FALLTHRU. + * primary.c (match_arg_list_function): Likewise. + * resolve.c (resolve_operator): Adjust fall through comment. + (fixup_charlen): Add FALLTHRU. + (resolve_allocate_expr): Adjust fall through comment. + * trans-array.c (gfc_conv_ss_startstride): Add FALLTHRU. + * trans-intrinsic.c (gfc_conv_intrinsic_len): Adjust fall through + comment. + +2016-08-11 Janne Blomqvist <jb@gcc.gnu.org> + + * check.c (gfc_check_random_seed): Use new seed size in check. + * intrinsic.texi (RANDOM_NUMBER): Updated documentation. + (RANDOM_SEED): Likewise. + +2016-08-08 Jakub Jelinek <jakub@redhat.com> + + PR fortran/72716 + * openmp.c (gfc_match_omp_declare_simd): Don't stick anything into + BLOCK DATA ns, it will be rejected later. + +2016-08-08 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/71936 + * trans-array.c (gfc_array_allocate): When SOURCE= is a function + stick with the ref of the object to allocate. + +2016-08-08 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/72698 + * trans-stmt.c (gfc_trans_allocate): Prevent generating code for + copy of zero sized string and with it an ICE. + +2016-08-08 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/70524 + * trans-array.c (gfc_trans_dummy_array_bias): Ensure that the + location information is correctly set. + * trans-decl.c (gfc_trans_deferred_vars): Set the locus of the + current construct early. + +2016-08-03 Fritz Reese <fritzoreese@gmail.com> + + * lang.opt: New option -fdec-intrinsic-ints. + * options.c (set_dec_flags): Enable with -fdec. + * gfortran.texi, invoke.texi, intrinsics.texi: Update documentation. + * intrinsic.c (add_function, add_subroutine): New B/I/J/K intrinsic + variants. + +2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/41922 + * target-memory.c (expr_to_char): Pass in locus and use it in error + messages. + (gfc_merge_initializers): Ditto. + * target-memory.h: Update prototype for gfc_merge_initializers (). + * trans-common.c (get_init_field): Use the correct locus. + +2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/68566 + * check.c (gfc_check_reshape): Check for constant expression. + +2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/69867 + * decl.c (build_struct): Ensure that pointers point to something. + +2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/69962 + * decl.c (gfc_set_constant_character_len): if expr is not + constant issue an error instead of an ICE. + +2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/70006 + * io.c (gfc_resolve_dt): Use correct locus. + * resolve.c (resolve_branch): Ditto. + +2016-07-30 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/71730 + * decl.c (char_len_param_value): Check return value of + gfc_reduce_init_expr(). + +2016-07-29 Dominik Vogt <vogt@linux.vnet.ibm.com> + + * trans-array.c (gfc_conv_array_ref): Fix allocation of diagnostic + message (was too small). + +2016-07-28 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/71067 + * decl.c (match_data_constant): On error, set 'result' to NULL. + +2016-07-28 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/71799 + * resolve.c(gfc_resolve_iterator): Failure of type conversion need + not ICE. + +2016-07-28 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/71859 + * check.c(numeric_check): Prevent ICE. Issue error for invalid + subroutine as an actual argument when numeric argument is expected. + +2016-07-28 Steven G. Kargl <kargl@gcc.gnu.org> + Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/71883 + * frontend-passes.c (gfc_run_passes): Bail out if there are any + errors. + * error.c (gfc_internal_error): If there are any errors in the + buffer, exit with EXIT_FAILURE. + +2016-07-28 Renlin Li <renlin.li@arm.com> + + Revert + 2016-07-19 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/71902 + * dependency.c (gfc_check_dependency): Use dep_ref. Handle case + if identical is true and two array element references differ. + (gfc_dep_resovler): Move most of the code to dep_ref. + (dep_ref): New function. + * frontend-passes.c (realloc_string_callback): Name temporary + variable "realloc_string". + +2016-07-26 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/71862 + * class.c: Remove assert. Iterate over component only if non-null. + +2016-07-22 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/71935 + * check.c (is_c_interoperable): Simplify right expression. + +2016-07-22 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/71795 + * frontend-passes.c (combine_array_constructor): Don't + do anything if the expression is inside an array iterator. + +2016-07-22 Andre Vehreschild <vehre@gcc.gnu.org> + + * expr.c (gfc_find_stat_co): Fixed whitespaces. + * gfortran.texi: Fixed typos and reversed meaning of caf_get()'s + src and dst description. + * trans-decl.c (gfc_build_builtin_function_decls): Fixed style + and corrected fnspec for caf functions. + * trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Fixed style. + (conv_caf_send): Dito. + +2016-07-19 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/71902 + * dependency.c (gfc_check_dependency): Use dep_ref. Handle case + if identical is true and two array element references differ. + (gfc_dep_resovler): Move most of the code to dep_ref. + (dep_ref): New function. + * frontend-passes.c (realloc_string_callback): Name temporary + variable "realloc_string". + +2016-07-17 Fritz Reese <fritzoreese@gmail.com> + + PR fortran/71523 + * trans-decl.c (gfc_finish_var_decl): Replace automatic initializer with + a static one. + +2016-07-15 Jerry DeLisle <jvdelisle@gcc.gnu.org> + Marco Restelli <mrestelli@gmail.com> + + PR fortran/62125 + * symbol.c (select_type_insert_tmp): Recursively call self to take care + of nested select type. + +2016-07-15 Cesar Philippidis <cesar@codesourcery.com> + + * openmp.c (gfc_match_omp_clauses): Scan for clause vector_length + before vector. + +2016-07-15 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/71807 + * trans-expr.c (gfc_trans_subcomponent_assign): Special casing + when allocatable component is set to null() in initializer. + +2016-07-14 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/29819 + * parse.c (parse_contained): Use proper locus. + +2016-07-14 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/70842 + * simplify.c (gfc_simplify_len): Only for unlimited polymorphic + types replace the expression's _data ref with a _len ref. + +2016-07-09 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/71783 + * frontend-passes.c (create_var): Always allocate a charlen + for character variables. + +2016-07-08 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/68426 + * simplify (gfc_simplify_spread): Adjust locus. + +2016-07-08 Cesar Philippidis <cesar@codesourcery.com> + + * parse.c (matcha): Define. + (decode_oacc_directive): Add spec_only local var and set it. Use + matcha to parse acc directives except for routine and declare. Return + ST_GET_FCN_CHARACTERISTICS if a non-declarative directive could be + matched. + +2016-07-08 Martin Liska <mliska@suse.cz> + + * invoke.texi (Wundefined-do-loop): Enhance documentation. + +2016-07-07 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/71764 + * trans-expr.c (gfc_trans_structure_assign): Remove assert. + +2016-07-07 Martin Liska <mliska@suse.cz> + + * lang.opt (Wundefined-do-loop): New option. + * resolve.c (gfc_resolve_iterator): Warn for Wundefined-do-loop. + (gfc_trans_simple_do): Generate a c-style loop. + (gfc_trans_do): Fix GNU coding style. + * invoke.texi: Mention the new warning. + +2016-07-07 Martin Liska <mliska@suse.cz> + + * trans-stmt.c (gfc_trans_do): Add expect builtin for DO + loops with step bigger than +-1. + +2016-07-05 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> + + * array.c (gfc_match_array_ref): Add parsing support for + STAT= attribute in CAF reference. + * expr.c (gfc_find_stat_co): New function that returns + the STAT= assignment. + * gfortran.h (gfc_array_ref): New member. + * trans-decl.c (gfc_build_builtin_function_decls): + new attribute for caf_get and caf_send functions. + * trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Passing + the stat attribute to external function. + (gfc_conv_intrinsic_caf_send): Ditto. + +2016-07-05 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/71623 + * trans-stmt.c (gfc_trans_allocate): Add code of pre block of typespec + in allocate to parent block. + +2016-07-04 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/66575 + * decl.c (match_procedure_interface): Exit loop if procedure + interface refers to itself. + +2016-07-04 Jerry DeLisle <jvdelisle@gcc.gnu.org> + Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/35849 + * simplify.c (gfc_simplify_ishftc): Check that absolute value of + SHIFT is less than or equal to SIZE. + +2016-07-01 Jakub Jelinek <jakub@redhat.com> + + PR fortran/71687 + * f95-lang.c (struct binding_level): Add reversed field. + (clear_binding_level): Adjust initializer. + (getdecls): If reversed is clear, set it and nreverse the names + chain before returning it. + (poplevel): Use getdecls. + * trans-decl.c (gfc_generate_function_code, gfc_process_block_locals): + Use nreverse to pushdecl decls in the declaration order. + + PR fortran/71717 + * trans-openmp.c (gfc_omp_privatize_by_reference): Return false + for GFC_DECL_ASSOCIATE_VAR_P with POINTER_TYPE. + +2016-06-30 Jakub Jelinek <jakub@redhat.com> + + PR fortran/71704 + * parse.c (matchs, matcho): Move right before decode_omp_directive. + If spec_only, only gfc_match the keyword and if successful, goto + do_spec_only. + (matchds, matchdo): Define. + (decode_omp_directive): Add spec_only local var and set it. + Use matchds or matchdo macros instead of matchs or matcho + for declare target, declare simd, declare reduction and threadprivate + directives. Return ST_GET_FCN_CHARACTERISTICS if a non-declarative + directive could be matched. + (next_statement): For ST_GET_FCN_CHARACTERISTICS restore + gfc_current_locus from old_locus even if there is no label. + + PR fortran/71705 + * trans-openmp.c (gfc_trans_omp_clauses): Set TREE_ADDRESSABLE on + decls in to/from clauses. + +2016-06-29 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/71686 + * scanner.c (gfc_next_char_literal): Only decrement nextc if it + is not NULL. + +2016-06-29 Cesar Philippidis <cesar@codesourcery.com> + + * openmp.c (match_oacc_clause_gang): Rename to ... + (match_oacc_clause_gwv): this. Add support for OpenACC worker and + vector clauses. + (gfc_match_omp_clauses): Use match_oacc_clause_gwv for + OMP_CLAUSE_{GANG,WORKER,VECTOR}. Propagate any MATCH_ERRORs for + invalid OMP_CLAUSE_{ASYNC,WAIT,GANG,WORKER,VECTOR} clauses. + (gfc_match_oacc_wait): Propagate MATCH_ERROR for invalid + oacc_expr_lists. Adjust the first and needs_space arguments to + gfc_match_omp_clauses. + +2016-06-29 Richard Biener <rguenther@suse.de> + + PR middle-end/71002 + * f95-lang.c (LANG_HOOKS_GET_ALIAS_SET): Remove (un-)define. + (gfc_get_alias_set): Remove. + +2016-06-25 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/71649 + * module.c (create_intrinsic_function): Check for NULL values and + return after giving error. + +2016-06-21 Michael Meissner <meissner@linux.vnet.ibm.com> + + * trans-types.c (gfc_build_complex_type): Move setting complex + MODE to layout_type, instead of setting it ahead of time by the + caller. + +2016-06-21 Tobias Burnus <burnus@net-b.de> + + PR fortran/71068 + * resolve.c (resolve_function): Don't resolve caf_get/caf_send. + (check_data_variable): Strip-off caf_get before checking. + +2016-06-20 Tobias Burnus <burnus@net-b.de> + + PR fortran/71194 + * trans-expr.c (gfc_trans_pointer_assignment): Correctly handle + RHS pointer functions. + +2016-06-19 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * class.c (gfc_add_class_array_ref): Call gfc_add_data_component() + instead of gfc_add_component_ref(). + (gfc_get_len_component): Call gfc_add_len_component() instead of + gfc_add_component_ref(). + * trans-intrinsic.c (gfc_conv_intrinsic_loc): Call + gfc_add_data_component() instead of gfc_add_component_ref(). + * trans.c (gfc_add_finalizer_call): Call + gfc_add_final_component() and gfc_add_size_component() instead + of gfc_add_component_ref. + +2016-06-18 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * trans-types.c (gfc_typenode_for_spec): Commentary typo fix. + +2016-06-17 Cesar Philippidis <cesar@codesourcery.com> + + * openmp.c (match_acc): New generic function to parse OpenACC + directives. + (gfc_match_oacc_parallel_loop): Use it. + (gfc_match_oacc_parallel): Likewise. + (gfc_match_oacc_kernels_loop): Likewise. + (gfc_match_oacc_kernels): Likewise. + (gfc_match_oacc_data): Likewise. + (gfc_match_oacc_host_data): Likewise. + (gfc_match_oacc_loop): Likewise. + (gfc_match_oacc_enter_data): Likewise. + (gfc_match_oacc_exit_data): Likewise. + +2016-06-16 Martin Liska <mliska@suse.cz> + + * trans-stmt.c (gfc_trans_simple_do): Predict the edge. + +2016-06-16 Martin Liska <mliska@suse.cz> + + * trans-array.c (gfc_array_allocate): Do not generate expect + stmt. + * trans.c (gfc_allocate_using_malloc): Properly set FAIL_ALLOC + predictor for malloc return value. + (gfc_allocate_allocatable): Use REALLOC predictor instead of + FAIL_ALLOC. + (gfc_deallocate_with_status): Likewise. + +2016-06-13 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/70673 + * frontend-passes.c (realloc_string_callback): Add a call to + gfc_dep_compare_expr. + +2016-06-11 Dominique d'Humieres <dominiq@lps.ens.fr> + + PR fortran/60751 + * io.c (gfc_resolve_dt): Replace GFC_STD_GNU with GFC_STD_LEGACY. + +2016-06-10 Thomas Schwinge <thomas@codesourcery.com> + + PR c/71381 + * openmp.c (gfc_match_oacc_cache): Add comment. + +2016-06-05 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/71404 + * io.c (match_io): For READ, commit in pending symbols in the + current statement before trying to match an expression so that + if the match fails and we undo symbols we dont toss good symbols. + +2016-06-05 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/69659 + * trans-array.c (gfc_trans_dummy_array_bias): For class arrays use + the address of the _data component to reference the arrays data + component. + +2016-06-03 Chung-Lin Tang <cltang@codesourcery.com> + + * trans-openmp.c (gfc_trans_omp_reduction_list): Add mark_addressable + bool parameter, set reduction clause DECLs as addressable when true. + (gfc_trans_omp_clauses): Pass clauses->async to + gfc_trans_omp_reduction_list, add comment describing OpenACC situation. + +2016-06-01 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/52393 + * io.c (match_io): For READ, try to match a default character + expression. If found, set the dt format expression to this, + otherwise go back and try control list. + +2016-06-01 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/71156 + * decl.c (copy_prefix): Add checks that the module procedure + declaration prefixes are compliant with the interface. Invert + order of existing elemental and pure checks. + * resolve.c (resolve_fl_procedure): Invert order of elemental + and pure errors. + +2016-06-01 Jakub Jelinek <jakub@redhat.com> + + * parse.c (case_decl): Move ST_OMP_* to ... + (case_omp_decl): ... here, new macro. + (verify_st_order): For case_omp_decl, complain about + p->state >= ORDER_EXEC, but don't change p->state otherwise. + +2016-05-26 Jakub Jelinek <jakub@redhat.com> + + * openmp.c (resolve_omp_clauses): Warn if chunk_size is known not to + be positive. + +2016-05-23 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/66461 + * scanner.c (gfc_next_char_literal): Clear end_flag when adjusting + current locus back to old_locus. + +2016-05-20 Jakub Jelinek <jakub@redhat.com> + + PR fortran/71204 + * frontend-passes.c (realloc_string_callback): Clear inserted_block + and changed_statement before calling create_var. + +2016-05-15 Harald Anlauf <anlauf@gmx.de> + + PR fortran/69603 + * interface.c (compare_parameter): Check for non-NULL pointer. + +2016-05-14 Fritz Reese <fritzoreese@gmail.com> + + * gfortran.texi: Update example of DEC UNION extension. + +2016-05-14 Fritz Reese <fritzoreese@gmail.com> + + PR fortran/71047 + * expr.c (gfc_default_initializer): Avoid extra component refs in + constructors for derived types and classes. + +2016-05-11 Jakub Jelinek <jakub@redhat.com> + + PR fortran/70855 + * frontend-passes.c (inline_matmul_assign): Disable in !$omp workshare. + +2016-05-09 Richard Biener <rguenther@suse.de> + + PR fortran/70937 + * trans-decl.c: Include gimplify.h for unshare_expr. + (gfc_trans_vla_one_sizepos): Unshare exprs before inserting + them into the IL. + +2016-05-07 Fritz Reese <fritzoreese@gmail.com> + + PR fortran/56226 + * module.c (dt_upper_string): Rename to gfc_dt_upper_string + (dt_lower_string): Likewise. + * gfortran.h: Make new gfc_dt_upper/lower_string global. + * class.c: Use gfc_dt_upper_string. + * decl.c: Likewise. + * symbol.c: Likewise. + * resolve.c (resolve_component): New function. + (resolve_fl_derived0): Move component loop code to resolve_component. + * parse.c (check_component): New function. + (parse_derived): Move loop code to check_component. + * lang.opt, invoke.texi, options.c : New option -fdec-structure. + * libgfortran.h (bt): New basic type BT_UNION. + * gfortran.h (gfc_option): New option -fdec-structure. + (gfc_get_union_type, gfc_compare_union_types): New prototypes. + (gfc_bt_struct, gfc_fl_struct, case_bt_struct, case_fl_struct): New + macros. + (gfc_find_component): Change prototype. + * match.h (gfc_match_member_sep, gfc_match_map, gfc_match_union, + gfc_match_structure_decl): New prototypes. + * parse.h (gfc_comp_struct): New macro. + * symbol.c (gfc_find_component): Search for components in nested unions + * class.c (insert_component_ref, gfc_add_component_ref, add_proc_comp, + copy_vtab_proc_comps): Update calls to gfc_find_component. + * primary.c (gfc_convert_to_structure_constructor): Likewise. + * symbol.c (gfc_add_component): Likewise. + * resolve.c (resolve_typebound_function, resolve_typebound_subroutine, + resolve_typebound_procedure, resolve_component, resolve_fl_derived): + Likewise. + * expr.c (get_union_init, component_init): New functions. + * decl.c (match_clist_expr, match_record_decl, get_struct_decl, + gfc_match_map, gfc_match_union, gfc_match_structure_decl): Likewise. + * interface.c (compare_components, gfc_compare_union_types): Likewise. + * match.c (gfc_match_member_sep): Likewise. + * parse.c (check_component, parse_union, parse_struct_map): Likewise. + * resolve.c (resolve_fl_struct): Likewise. + * symbol.c (find_union_component): Likewise. + * trans-types.c (gfc_get_union_type): Likewise. + * parse.c (parse_derived): Use new functions. + * interface.c (gfc_compare_derived_types, gfc_compare_types): Likewise. + * expr.c (gfc_default_initializer): Likewise. + * gfortran.texi: Support for DEC structures, unions, and maps. + * gfortran.h (gfc_statement, sym_flavor): Likewise. + * check.c (gfc_check_kill_sub): Likewise. + * expr.c (gfc_copy_expr, simplify_const_ref, + gfc_has_default_initializer): Likewise. + * decl.c (build_sym, match_data_constant, add_init_expr_to_sym, + match_pointer_init, build_struct, variable_decl, + gfc_match_decl_type_spec, gfc_mach_data-decl, gfc_match_entry, + gfc_match_end, gfc_match_derived_decl): Likewise. + * interface.c (check_interface0, check_interface1, + gfc_search_interface): Likewise. + * misc.c (gfc_basic_typename, gfc_typename): Likewise. + * module.c (add_true_name, build_tnt, bt_types, mio_typespec, + fix_mio_expr, load_needed, mio_symbol, read_module, write_symbol, + gfc_get_module_backend_decl): Likewise. + * parse.h (gfc_compile_state): Likewise. + * parse.c (decode_specification_statement, decode_statement, + gfc_ascii_statement, verify_st_order, parse_spec): Likewise. + * primary.c (gfc_match_varspec, gfc_match_structure_constructor, + gfc_match_rvalue, match_variable): Likewise. + * resolve.c (find_arglists, resolve_structure_cons, + is_illegal_recursion, resolve_generic_f, get_declared_from_expr, + resolve_typebound_subroutine, resolve_allocate_expr, + nonscalar_typebound_assign, generate_component_assignments, + resolve_fl_variable_derived, check_defined_assignments, + resolve_component, resolve_symbol, resolve_equivalence_derived): + Likewise. + * symbol.c (flavors, check_conflict, gfc_add_flavor, gfc_use_derived, + gfc_restore_last_undo_checkpoint, gfc_type_compatible, + gfc_find_dt_in_generic): Likewise. + * trans-decl.c (gfc_get_module_backend_decl, create_function_arglist, + gfc_create_module_variable, check_constant_initializer): Likewise. + * trans-expr.c (gfc_conv_component_ref, gfc_conv_initializer, + gfc_trans_alloc_subarray_assign, gfc_trans_subcomponent_assign, + gfc_conv_structure, gfc_trans_scalar_assign, copyable_array_p): + Likewise. + * trans-io.c (transfer_namelist_element, transfer_expr, + gfc_trans_transfer): Likewise. + * trans-stmt.c (gfc_trans_deallocate): Likewise. + * trans-types.c (gfc_typenode_for_spec, gfc_copy_dt_decls_ifequal, + gfc_get_derived_type): Likewise. + +2016-05-05 Jakub Jelinek <jakub@redhat.com> + + * openmp.c (gfc_match_omp_clauses): Restructuralize, so that clause + parsing is done in a big switch based on gfc_peek_ascii_char and + individual clauses under their first letters are sorted too. + +2016-05-02 Michael Meissner <meissner@linux.vnet.ibm.com> + + * trans-types.c (gfc_build_complex_type): + +2016-05-02 Richard Biener <rguenther@suse.de> + + * trans-array.c (gfc_trans_create_temp_array): Properly + create a DECL_EXPR for the anonymous VLA array type. + +2016-04-29 Cesar Philippidis <cesar@codesourcery.com> + + PR middle-end/70626 + * trans-openmp.c (gfc_trans_oacc_combined_directive): Duplicate + the reduction clause in both parallel and loop directives. + +2016-04-18 Michael Matz <matz@suse.de> + + * trans-io.c (gfc_build_io_library_fndecls): Use SET_TYPE_ALIGN. + * trans-common.c (build_common_decl): Use SET_DECL_ALIGN. + * trans-types.c (gfc_add_field_to_struct): Use SET_DECL_ALIGN. + +2016-04-13 Dominique d'Humieres <dominiq@lps.ens.fr> + + PR fortran/67039 + * intrinsic.texi: Correct the documentation of pseudorandom + number intrinsics. + +2016-04-13 Dominique d'Humieres <dominiq@lps.ens.fr> + + PR fortran/58000 + * gfortran.texi: Document OPEN( ... NAME=) as not implemented + in GNU Fortran + +2016-04-09 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/68566 + * array.c (match_array_element_spec): Add check for non-integer. + * simplify.c (gfc_simplify_reshape): If source shape is NULL return. + +2016-04-06 Patrick Palka <ppalka@gcc.gnu.org> + + PR c/70436 + * openmp.c (gfc_find_omp_udr): Add explicit braces to resolve a + future -Wparentheses warning. + +2016-04-04 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/67538 + * resolve.c (resolve_allocate_expr): Emit error message when no + array spec and no array valued source= expression is given in an + F2008 allocate() for an array to allocate. + +2016-04-04 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/65795 + * trans-array.c (gfc_array_allocate): When the array is a coarray, + do not nullyfing its allocatable components in array_allocate, because + the nullify missed the array ref and nullifies the wrong component. + Cosmetics. + +2016-03-29 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/70397 + * trans-expr.c (gfc_class_len_or_zero_get): Add function to return a + constant zero tree, when the class to get the _len component from is + not unlimited polymorphic. + (gfc_copy_class_to_class): Use the new function. + * trans.h: Added interface of new function gfc_class_len_or_zero_get. + +2016-03-28 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> + + * trans-decl.c (gfc_build_builtin_function_decls): + caf_stop_numeric and caf_stop_str definition. + * trans-stmt.c (gfc_trans_stop): invoke external functions + for stop and stop_str when coarrays are used. + * trans.h: extern for new functions. + +2016-03-19 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/69043 + * scanner.c (load_file): Update to use S_ISREG macro. + +2016-03-17 Thomas Schwinge <thomas@codesourcery.com> + + * gfortran.h (enum gfc_omp_map_op): Rename OMP_MAP_FORCE_DEALLOC + to OMP_MAP_DELETE. Adjust all users. + +2016-03-13 Jerry DeLisle <jvdelisle@gcc.gnu.org> + Jim MacArthur <jim.macarthur@codethink.co.uk> + + PR fortran/69043 + * scanner.c (load_file): Check that included file is regular. + +2016-03-12 Jerry DeLisle <jvdelisle@gcc.gnu.org> + Harold Anlauf <anlauf@gmx.de> + + PR fortran/69520 + * invoke.texi: Explain use of the 'no-' construct within the + -fcheck= option. + * options.c (gfc_handle_runtime_check_option): Enable use of + 'no-' prefix for the various options with -fcheck= to allow + negating previously enabled check options. + +2016-03-12 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/70031 + * decl.c (gfc_match_prefix): Treat the 'module' prefix in the + same way as the others, rather than fixing it to come last. + (gfc_match_function_decl, gfc_match_subroutine): After errors + in 'copy_prefix', emit them immediately in the case of module + procedures to prevent a later ICE. + + PR fortran/69524 + * decl.c (gfc_match_submod_proc): Permit 'module procedure' + declarations within the contains section of modules as well as + submodules. + * resolve.c (resolve_fl_procedure): Likewise. + *trans-decl.c (build_function_decl): Change the gcc_assert to + allow all forms of module procedure declarations within module + contains sections. + +2016-02-28 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/68147 + PR fortran/47674 + * frontend-passes.c (realloc_string_callback): Don't set + walk_subtrees. + +2016-02-28 Thomas Koenig <tkoenig@gcc.gnu.org> + + * dump-parse-tree.c (show_code_node): Print association + list of a block if present. Handle EXEC_END_BLOCK. + +2016-02-28 Harald Anlauf <anlauf@gmx.de> + Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/56007 + * match.c (gfc_match_iterator): Add diagnostic for array variable + as do loop index. + +2016-02-27 Jerry DeLisle <jvdelisle@gcc.gnu.org> + Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/69910 + * io.c (gfc_match_open): Check that open status is an expression + constant before comparing string to 'scratch' with NEWUNIT. + +2016-02-27 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> + + * trans.c (gfc_allocate_allocatable): size conversion + from byte to number of elements for event variables. + * trans-types.c (gfc_get_derived_type): event variables + represented as a pointer (like lock variable). + +2016-02-23 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/61156 + * scanner.c (add_path_to_list): If include path is not a directory, + issue a fatal error. + +2016-02-23 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/67451 + * trans-array.c (gfc_array_allocate): Take the attributes from the + expression to allocate and not from the source=-expression. + +2016-02-20 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/69423 + * trans-decl.c (create_function_arglist): Deferred character + length functions, with and without declared results, address + the passed reference type as '.result' and the local string + length as '..result'. + (gfc_null_and_pass_deferred_len): Helper function to null and + return deferred string lengths, as needed. + (gfc_trans_deferred_vars): Call it, thereby reducing repeated + code, add call for deferred arrays and reroute pointer function + results. Avoid using 'tmp' for anything other that a temporary + tree by introducing 'type_of_array' for the arrayspec type. + +2015-02-16 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/69742 + * frontend-passes.c (cfe-expr_0): Don't register functions + from within an ASSOCIATE statement. + +2016-02-14 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/60526 + * decl.c (build_sym): If the name has already been defined as a + type, it has a symtree with an upper case letter at the beginning. + If such a symtree exists, issue an error and exit. Don't do + this if there is no corresponding upper case letter. + +2016-02-14 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/60526 + PR bootstrap/69816 + * decl.c (build_sym): Reverted previous patch. + +2016-02-14 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/60526 + * decl.c (build_sym): If the name has already been defined as a + type, issue error and return false. + +2016-02-12 David Malcolm <dmalcolm@redhat.com> + + PR other/69554 + * error.c (gfc_diagnostic_start_span): New function. + (gfc_diagnostics_init): Initialize global_dc's start_span. + +2016-02-11 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/69296 + * gfortran.h: Added flag to gfc_association_list indicating that + the rank of an associate variable has been guessed only. + * parse.c (parse_associate): Set the guess flag mentioned above + when guessing the rank of an expression. + * resolve.c (resolve_assoc_var): When the rank has been guessed, + make sure, that the guess was correct else overwrite with the actual + rank. + * trans-stmt.c (trans_associate_var): For subref_array_pointers in + class objects, take the span from the _data component. + +2016-02-07 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/50555 + * primary.c (match_actual_arg): If symbol has attribute flavor of + namelist, generate an error. (gfc_match_rvalue): Likewise return + MATCH_ERROR. + * resolve.c (resolve_symbol): Scan arument list of procedures and + generate an error if a namelist is found. + +2016-02-05 Mikael Morin <mikael@gcc.gnu.org> + + PR fortran/66089 + * trans-expr.c (expr_is_variable, gfc_expr_is_variable): Rename + the former to the latter and make it non-static. Update callers. + * gfortran.h (gfc_expr_is_variable): New declaration. + (struct gfc_ss_info): Add field needs_temporary. + * trans-array.c (gfc_scalar_elemental_arg_saved_as_argument): + Tighten the condition on aggregate expressions with a check + that the expression is a variable and doesn't need a temporary. + (gfc_conv_resolve_dependency): Add intermediary reference variable. + Set the needs_temporary field. + +2016-02-03 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/67451 + PR fortran/69418 + * trans-expr.c (gfc_copy_class_to_class): For coarrays just the + pointer is passed. Take it as is without trying to deref the + _data component. + * trans-stmt.c (gfc_trans_allocate): Take care of coarrays as + argument to source=-expression. + +2016-02-02 Nathan Sidwell <nathan@codesourcery.com> + + * lang.opt (fopenacc-dim=): New option. + +2016-01-31 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/67564 + * trans-expr.c (gfc_conv_procedure_call): For the vtable copy + subroutines, add a string length argument, when the actual + argument is an unlimited polymorphic class object. + +2016-01-30 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/69566 + * trans-expr.c (gfc_conv_procedure_call): Correct expression + for 'ulim_copy', which was missing a test for 'comp'. + +2016-01-28 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/62536 + * decl.c (gfc_match_end): Only unnest and remove BLOCK namespaces + when the END encountered does not match a BLOCK's end. + +2016-01-27 Janus Weil <janus@gcc.gnu.org> + + PR fortran/69484 + * invoke.texi: Fix documentation of -Wall with respect to -Wtabs. + +2016-01-27 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/69422 + * trans-expr.c (is_scalar_reallocatable_lhs): Remove the check + for allocatable components, whilst checking if the symbol is a + derived or class entity.. + +2016-01-26 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/69385 + * trans-expr.c (gfc_trans_assignment_1): Exclude initialization + assignments from check on assignment of scalars to unassigned + arrays and correct wrong code within the corresponding block. + +2016-01-26 David Malcolm <dmalcolm@redhat.com> + + PR other/69006 + * error.c (gfc_diagnostic_starter): Delete use of pp_newline. + +2016-01-23 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/69397 + PR fortran/68442 + * interface.c (gfc_arglist_matches_symbol): Replace assert with + a return false if not a procedure. + * resolve.c (resolve_generic_f): Test if we are resolving an + initialization expression and adjust error message accordingly. + +2016-01-24 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/66094 + * frontend-passes.c (matmul_lhs_realloc): Add + forgotten break statement. + +2016-01-24 Dominique d'Humieres <dominiq@lps.ens.fr> + + PR fortran/68283 + * primary.c (gfc_variable_attr): revert revision r221955, + call gfc_internal_error only if there is no error. + +2016-01-24 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/66094 + * frontend-passes.c (enum matrix_case): Add case A2B2T for + MATMUL(A,TRANSPoSE(B)) where A and B are rank 2. + (inline_limit_check): Also add A2B2T. + (matmul_lhs_realloc): Handle A2B2T. + (check_conjg_variable): Rename to + (check_conjg_transpose_variable): and also count TRANSPOSE. + (inline_matmul_assign): Handle A2B2T. + +2016-01-21 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/65996 + * error.c (gfc_error): Save the state of abort_on_error and set + it to false for buffered errors to allow normal processing. + Restore the state before leaving. + +2016-01-19 Martin Jambor <mjambor@suse.cz> + + * types.def (BT_FN_VOID_UINT_PTR_INT_PTR): New. + (BT_FN_VOID_INT_OMPFN_SIZE_PTR_PTR_PTR_UINT_PTR_INT_INT): Removed. + (BT_FN_VOID_INT_OMPFN_SIZE_PTR_PTR_PTR_UINT_PTR_PTR): New. + +2016-01-15 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/64324 + * resolve.c (check_uop_procedure): Prevent deferred length + characters from being trapped by assumed length error. + + PR fortran/49630 + PR fortran/54070 + PR fortran/60593 + PR fortran/60795 + PR fortran/61147 + PR fortran/64324 + * trans-array.c (gfc_conv_scalarized_array_ref): Pass decl for + function as well as variable expressions. + (gfc_array_init_size): Add 'expr' as an argument. Use this to + correctly set the descriptor dtype for deferred characters. + (gfc_array_allocate): Add 'expr' to the call to + 'gfc_array_init_size'. + * trans.c (gfc_build_array_ref): Expand logic for setting span + to include indirect references to character lengths. + * trans-decl.c (gfc_get_symbol_decl): Ensure that deferred + result char lengths that are PARM_DECLs are indirectly + referenced both for directly passed and by reference. + (create_function_arglist): If the length type is a pointer type + then store the length as the 'passed_length' and make the char + length an indirect reference to it. + (gfc_trans_deferred_vars): If a character length has escaped + being set as an indirect reference, return it via the 'passed + length'. + * trans-expr.c (gfc_conv_procedure_call): The length of + deferred character length results is set TREE_STATIC and set to + zero. + (gfc_trans_assignment_1): Do not fix the rse string_length if + it is a variable, a parameter or an indirect reference. Add the + code to trap assignment of scalars to unallocated arrays. + * trans-stmt.c (gfc_trans_allocate): Remove 'def_str_len' and + all references to it. Instead, replicate the code to obtain a + explicitly defined string length and provide a value before + array allocation so that the dtype is correctly set. + trans-types.c (gfc_get_character_type): If the character length + is a pointer, use the indirect reference. + +2016-01-10 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/69154 + * frontend-passes.c (in_where): New variable. + (inline_matmul_assign): Don't try this if we are within + a WHERE statement. + (gfc_code_walker): Keep track of in_where. + +2016-01-10 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/67779 + * trans_array.c (gfc_conv_scalarized_array_ref): Add missing + se->use_offset from condition for calculation of 'base'. + +2016-01-08 Jakub Jelinek <jakub@redhat.com> + + PR fortran/69128 + * trans.h (OMPWS_SCALARIZER_BODY): Define. + (OMPWS_NOWAIT): Renumber. + * trans-stmt.c (gfc_trans_where_3): Only set OMPWS_SCALARIZER_WS + if OMPWS_SCALARIZER_BODY is not set already, and set also + OMPWS_SCALARIZER_BODY until the final loop creation. + * trans-expr.c (gfc_trans_assignment_1): Likewise. + * trans-openmp.c (gfc_trans_omp_workshare): Also clear + OMPWS_SCALARIZER_BODY. + * trans-array.c (gfc_trans_scalarized_loop_end): Don't create + OMP_FOR if OMPWS_SCALARIZER_BODY is set. + +2016-01-04 Jakub Jelinek <jakub@redhat.com> + + Update copyright years. + + * 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. + +2016-01-01 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/68864 + * trans-array.c (evaluate_bound): If deferred, test that 'desc' + is an array descriptor before using gfc_conv_descriptor_xxx. + +Copyright (C) 2016 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 33d226644c..14481fde4c 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-2016 Free Software Foundation, Inc. +# Copyright (C) 2002-2017 Free Software Foundation, Inc. # Contributed by Paul Brook <paul@nowt.org # and Steven Bosscher <s.bosscher@student.tudelft.nl> diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 47a5504699..8fa305c6ae 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -1,5 +1,5 @@ /* Compiler arithmetic - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -874,8 +874,12 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) { /* if op2 < 0, op1**op2 == 0 because abs(op1) > 1. */ mpz_set_si (result->value.integer, 0); + if (warn_integer_division) + gfc_warning_now (OPT_Winteger_division, "Negative " + "exponent of integer has zero " + "result at %L", &result->where); } - else if (gfc_extract_int (op2, &power) != NULL) + else if (gfc_extract_int (op2, &power)) { /* If op2 doesn't fit in an int, the exponentiation will overflow, because op2 > 0 and abs(op1) > 1. */ @@ -1521,7 +1525,7 @@ eval_intrinsic (gfc_intrinsic_op op, break; } - /* Fall through */ + gcc_fallthrough (); /* Numeric binary */ case INTRINSIC_PLUS: case INTRINSIC_MINUS: @@ -2072,11 +2076,11 @@ gfc_int2real (gfc_expr *src, int kind) if (warn_conversion && wprecision_int_real (src->value.integer, result->value.real)) - gfc_warning_now (OPT_Wconversion, "Change of value in conversion " - "from %qs to %qs at %L", - gfc_typename (&src->ts), - gfc_typename (&result->ts), - &src->where); + gfc_warning (OPT_Wconversion, "Change of value in conversion " + "from %qs to %qs at %L", + gfc_typename (&src->ts), + gfc_typename (&result->ts), + &src->where); return result; } @@ -2369,10 +2373,10 @@ gfc_complex2real (gfc_expr *src, int kind) /* See if we discarded an imaginary part. */ if (mpfr_cmp_si (mpc_imagref (src->value.complex), 0) != 0) { - gfc_warning_now (w, "Non-zero imaginary part discarded " - "in conversion from %qs to %qs at %L", - gfc_typename(&src->ts), gfc_typename (&result->ts), - &src->where); + gfc_warning (w, "Non-zero imaginary part discarded " + "in conversion from %qs to %qs at %L", + gfc_typename(&src->ts), gfc_typename (&result->ts), + &src->where); did_warn = true; } diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h index 2bed49095b..9c623a42ab 100644 --- a/gcc/fortran/arith.h +++ b/gcc/fortran/arith.h @@ -1,5 +1,5 @@ /* Compiler arithmetic header. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 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.c index 1430e80251..ec0c26656f 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1,5 +1,5 @@ /* Array things - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -156,6 +156,8 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init, { match m; bool matched_bracket = false; + gfc_expr *tmp; + bool stat_just_seen = false; memset (ar, '\0', sizeof (*ar)); @@ -220,12 +222,27 @@ coarray: return MATCH_ERROR; } + ar->stat = NULL; + for (ar->codimen = 0; ar->codimen + ar->dimen < GFC_MAX_DIMENSIONS; ar->codimen++) { m = match_subscript (ar, init, true); if (m == MATCH_ERROR) return MATCH_ERROR; + stat_just_seen = false; + if (gfc_match(" , stat = %e",&tmp) == MATCH_YES && ar->stat == NULL) + { + ar->stat = tmp; + stat_just_seen = true; + } + + if (ar->stat && !stat_just_seen) + { + gfc_error ("STAT= attribute in %C misplaced"); + return MATCH_ERROR; + } + if (gfc_match_char (']') == MATCH_YES) { ar->codimen++; @@ -1072,8 +1089,8 @@ match_array_cons_element (gfc_constructor_base *result) match gfc_match_array_constructor (gfc_expr **result) { - gfc_constructor_base head, new_cons; - gfc_undo_change_set changed_syms; + gfc_constructor *c; + gfc_constructor_base head; gfc_expr *expr; gfc_typespec ts; locus where; @@ -1081,6 +1098,9 @@ gfc_match_array_constructor (gfc_expr **result) const char *end_delim; bool seen_ts; + head = NULL; + seen_ts = false; + if (gfc_match (" (/") == MATCH_NO) { if (gfc_match (" [") == MATCH_NO) @@ -1097,12 +1117,9 @@ gfc_match_array_constructor (gfc_expr **result) end_delim = " /)"; where = gfc_current_locus; - head = new_cons = NULL; - seen_ts = false; /* Try to match an optional "type-spec ::" */ gfc_clear_ts (&ts); - gfc_new_undo_checkpoint (changed_syms); m = gfc_match_type_spec (&ts); if (m == MATCH_YES) { @@ -1112,33 +1129,29 @@ gfc_match_array_constructor (gfc_expr **result) { if (!gfc_notify_std (GFC_STD_F2003, "Array constructor " "including type specification at %C")) + goto cleanup; + + if (ts.deferred) { - gfc_restore_last_undo_checkpoint (); + gfc_error ("Type-spec at %L cannot contain a deferred " + "type parameter", &where); goto cleanup; } - if (ts.deferred) + if (ts.type == BT_CHARACTER + && ts.u.cl && !ts.u.cl->length && !ts.u.cl->length_from_typespec) { - gfc_error ("Type-spec at %L cannot contain a deferred " + gfc_error ("Type-spec at %L cannot contain an asterisk for a " "type parameter", &where); - gfc_restore_last_undo_checkpoint (); goto cleanup; } } } else if (m == MATCH_ERROR) - { - gfc_restore_last_undo_checkpoint (); - goto cleanup; - } + goto cleanup; - if (seen_ts) - gfc_drop_last_undo_checkpoint (); - else - { - gfc_restore_last_undo_checkpoint (); - gfc_current_locus = where; - } + if (!seen_ts) + gfc_current_locus = where; if (gfc_match (end_delim) == MATCH_YES) { @@ -1177,8 +1190,6 @@ done: be converted. See PR fortran/67803. */ if (ts.type == BT_CHARACTER) { - gfc_constructor *c; - c = gfc_constructor_first (head); for (; c; c = gfc_constructor_next (c)) { @@ -1201,6 +1212,14 @@ done: } } } + + /* Walk the constructor and ensure type conversion for numeric types. */ + if (gfc_numeric_ts (&ts)) + { + c = gfc_constructor_first (head); + for (; c; c = gfc_constructor_next (c)) + gfc_convert_type (c->expr, &ts, 1); + } } else expr = gfc_get_array_expr (BT_UNKNOWN, 0, &where); @@ -2544,7 +2563,7 @@ cleanup: characterizes the reference. */ gfc_array_ref * -gfc_find_array_ref (gfc_expr *e) +gfc_find_array_ref (gfc_expr *e, bool allow_null) { gfc_ref *ref; @@ -2554,7 +2573,12 @@ gfc_find_array_ref (gfc_expr *e) break; if (ref == NULL) - gfc_internal_error ("gfc_find_array_ref(): No ref found"); + { + if (allow_null) + return NULL; + else + gfc_internal_error ("gfc_find_array_ref(): No ref found"); + } return &ref->u.ar; } @@ -2562,18 +2586,16 @@ gfc_find_array_ref (gfc_expr *e) /* Find out if an array shape is known at compile time. */ -int +bool gfc_is_compile_time_shape (gfc_array_spec *as) { - int i; - if (as->type != AS_EXPLICIT) - return 0; + return false; - for (i = 0; i < as->rank; i++) + for (int i = 0; i < as->rank; i++) if (!gfc_is_constant_expr (as->lower[i]) || !gfc_is_constant_expr (as->upper[i])) - return 0; + return false; - return 1; + return true; } diff --git a/gcc/fortran/bbt.c b/gcc/fortran/bbt.c index 8167dd538d..37b5dc3c09 100644 --- a/gcc/fortran/bbt.c +++ b/gcc/fortran/bbt.c @@ -1,5 +1,5 @@ /* Balanced binary trees using treaps. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 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.c index d26e45ec40..45bc68ef7a 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1,5 +1,5 @@ /* Check functions - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -72,6 +72,11 @@ type_check (gfc_expr *e, int n, bt type) static bool numeric_check (gfc_expr *e, int n) { + /* Users sometime use a subroutine designator as an actual argument to + an intrinsic subprogram that expects an argument with a numeric type. */ + if (e->symtree && e->symtree->n.sym->attr.subroutine) + goto error; + if (gfc_numeric_ts (&e->ts)) return true; @@ -86,7 +91,9 @@ numeric_check (gfc_expr *e, int n) return true; } - gfc_error ("%qs argument of %qs intrinsic at %L must be a numeric type", +error: + + gfc_error ("%qs argument of %qs intrinsic at %L must have a numeric type", gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where); @@ -170,7 +177,7 @@ kind_check (gfc_expr *k, int n, bt type) return false; } - if (gfc_extract_int (k, &kind) != NULL + if (gfc_extract_int (k, &kind) || gfc_validate_kind (type, kind, true) < 0) { gfc_error ("Invalid kind for %s at %L", gfc_basic_typename (type), @@ -288,6 +295,29 @@ nonnegative_check (const char *arg, gfc_expr *expr) } +/* If expr is a constant, then check to ensure that it is greater than zero. */ + +static bool +positive_check (int n, gfc_expr *expr) +{ + int i; + + if (expr->expr_type == EXPR_CONSTANT) + { + gfc_extract_int (expr, &i); + if (i <= 0) + { + gfc_error ("%qs argument of %qs intrinsic at %L must be positive", + gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, + &expr->where); + return false; + } + } + + return true; +} + + /* If expr2 is constant, then check that the value is less than (less than or equal to, if 'or_equal' is true) bit_size(expr1). */ @@ -844,6 +874,17 @@ gfc_check_all_any (gfc_expr *mask, gfc_expr *dim) bool gfc_check_allocated (gfc_expr *array) { + /* Tests on allocated components of coarrays need to detour the check to + argument of the _caf_get. */ + if (flag_coarray == GFC_FCOARRAY_LIB && array->expr_type == EXPR_FUNCTION + && array->value.function.isym + && array->value.function.isym->id == GFC_ISYM_CAF_GET) + { + array = array->value.function.actual->expr; + if (!array->ref) + return false; + } + if (!variable_check (array, 0, false)) return false; if (!allocatable_check (array, 0)) @@ -873,7 +914,7 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p) if (a->ts.kind != p->ts.kind) { - if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", + if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", &p->where)) return false; } @@ -1120,6 +1161,60 @@ gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom, gfc_expr *stat) bool +gfc_check_image_status (gfc_expr *image, gfc_expr *team) +{ + /* IMAGE has to be a positive, scalar integer. */ + if (!type_check (image, 0, BT_INTEGER) || !scalar_check (image, 0) + || !positive_check (0, image)) + return false; + + if (team) + { + gfc_error ("%qs argument of %qs intrinsic at %L not yet supported", + gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, + &team->where); + return false; + } + return true; +} + + +bool +gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind) +{ + if (team) + { + gfc_error ("%qs argument of %qs intrinsic at %L not yet supported", + gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, + &team->where); + return false; + } + + if (kind) + { + int k; + + if (!type_check (kind, 1, BT_INTEGER) || !scalar_check (kind, 1) + || !positive_check (1, kind)) + return false; + + /* Get the kind, reporting error on non-constant or overflow. */ + gfc_current_locus = kind->where; + if (gfc_extract_int (kind, &k, 1)) + return false; + if (gfc_validate_kind (BT_INTEGER, k, true) == -1) + { + gfc_error ("%qs argument of %qs intrinsic at %L shall specify a " + "valid integer kind", gfc_current_intrinsic_arg[1]->name, + gfc_current_intrinsic, &kind->where); + return false; + } + } + return true; +} + + +bool gfc_check_atomic_cas (gfc_expr *atom, gfc_expr *old, gfc_expr *compare, gfc_expr *new_val, gfc_expr *stat) { @@ -1790,7 +1885,7 @@ gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind) if (!kind_check (kind, 2, BT_INTEGER)) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -2120,11 +2215,11 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, } else if (boundary->rank == array->rank - 1) { - if (!gfc_check_conformance (shift, boundary, + if (!gfc_check_conformance (shift, boundary, "arguments '%s' and '%s' for " - "intrinsic %s", - gfc_current_intrinsic_arg[1]->name, - gfc_current_intrinsic_arg[2]->name, + "intrinsic %s", + gfc_current_intrinsic_arg[1]->name, + gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic)) return false; } @@ -2149,7 +2244,7 @@ gfc_check_float (gfc_expr *a) if ((a->ts.kind != gfc_default_integer_kind) && !gfc_notify_std (GFC_STD_GNU, "non-default INTEGER " - "kind argument to %s intrinsic at %L", + "kind argument to %s intrinsic at %L", gfc_current_intrinsic, &a->where)) return false; @@ -2276,7 +2371,7 @@ gfc_check_iand (gfc_expr *i, gfc_expr *j) if (i->ts.kind != j->ts.kind) { - if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", + if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", &i->where)) return false; } @@ -2322,7 +2417,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -2402,7 +2497,7 @@ gfc_check_ieor (gfc_expr *i, gfc_expr *j) if (i->ts.kind != j->ts.kind) { - if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", + if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", &i->where)) return false; } @@ -2425,7 +2520,7 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back, if (!kind_check (kind, 3, BT_INTEGER)) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -2476,7 +2571,7 @@ gfc_check_ior (gfc_expr *i, gfc_expr *j) if (i->ts.kind != j->ts.kind) { - if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", + if (!gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L", &i->where)) return false; } @@ -2626,7 +2721,7 @@ gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) if (!kind_check (kind, 2, BT_INTEGER)) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -2671,7 +2766,7 @@ gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind) if (!kind_check (kind, 1, BT_INTEGER)) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -2941,7 +3036,7 @@ gfc_check_min_max (gfc_actual_arglist *arg) if (x->ts.type == BT_CHARACTER) { if (!gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with CHARACTER argument at %L", + "with CHARACTER argument at %L", gfc_current_intrinsic, &x->where)) return false; } @@ -3111,10 +3206,10 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap) return false; if (m != NULL - && !gfc_check_conformance (a, m, - "arguments '%s' and '%s' for intrinsic %s", - gfc_current_intrinsic_arg[0]->name, - gfc_current_intrinsic_arg[2]->name, + && !gfc_check_conformance (a, m, + "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic)) return false; @@ -3165,10 +3260,10 @@ check_reduction (gfc_actual_arglist *ap) return false; if (m != NULL - && !gfc_check_conformance (a, m, - "arguments '%s' and '%s' for intrinsic %s", - gfc_current_intrinsic_arg[0]->name, - gfc_current_intrinsic_arg[2]->name, + && !gfc_check_conformance (a, m, + "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic)) return false; @@ -3335,6 +3430,46 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to) return false; } + /* This is based losely on F2003 12.4.1.7. It is intended to prevent + the likes of to = sym->cmp1->cmp2 and from = sym->cmp1, where cmp1 + and cmp2 are allocatable. After the allocation is transferred, + the 'to' chain is broken by the nullification of the 'from'. A bit + of reflection reveals that this can only occur for derived types + with recursive allocatable components. */ + if (to->expr_type == EXPR_VARIABLE && from->expr_type == EXPR_VARIABLE + && !strcmp (to->symtree->n.sym->name, from->symtree->n.sym->name)) + { + gfc_ref *to_ref, *from_ref; + to_ref = to->ref; + from_ref = from->ref; + bool aliasing = true; + + for (; from_ref && to_ref; + from_ref = from_ref->next, to_ref = to_ref->next) + { + if (to_ref->type != from->ref->type) + aliasing = false; + else if (to_ref->type == REF_ARRAY + && to_ref->u.ar.type != AR_FULL + && from_ref->u.ar.type != AR_FULL) + /* Play safe; assume sections and elements are different. */ + aliasing = false; + else if (to_ref->type == REF_COMPONENT + && to_ref->u.c.component != from_ref->u.c.component) + aliasing = false; + + if (!aliasing) + break; + } + + if (aliasing) + { + gfc_error ("The FROM and TO arguments at %L violate aliasing " + "restrictions (F2003 12.4.1.7)", &to->where); + return false; + } + } + /* CLASS arguments: Make sure the vtab of from is present. */ if (to->ts.type == BT_CLASS && !UNLIMITED_POLY (from)) gfc_find_vtab (&from->ts); @@ -3440,10 +3575,10 @@ gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector) if (!type_check (mask, 1, BT_LOGICAL)) return false; - if (!gfc_check_conformance (array, mask, - "arguments '%s' and '%s' for intrinsic '%s'", - gfc_current_intrinsic_arg[0]->name, - gfc_current_intrinsic_arg[1]->name, + if (!gfc_check_conformance (array, mask, + "arguments '%s' and '%s' for intrinsic '%s'", + gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic)) return false; @@ -3609,7 +3744,7 @@ gfc_check_range (gfc_expr *x) bool -gfc_check_rank (gfc_expr *a ATTRIBUTE_UNUSED) +gfc_check_rank (gfc_expr *a) { /* Any data object is allowed; a "data object" is a "constant (4.1.3), variable (6), or subobject of a constant (2.4.3.2.3)" (F2008, 1.3.45). */ @@ -3820,7 +3955,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, if (!type_check (order, 3, BT_INTEGER)) return false; - if (order->expr_type == EXPR_ARRAY) + if (order->expr_type == EXPR_ARRAY && gfc_is_constant_expr (order)) { int i, order_size, dim, perm[GFC_MAX_DIMENSIONS]; gfc_expr *e; @@ -3982,7 +4117,7 @@ gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind) if (!kind_check (kind, 3, BT_INTEGER)) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -4043,7 +4178,7 @@ gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix) { if (p == NULL && r == NULL && !gfc_notify_std (GFC_STD_F2008, "SELECTED_REAL_KIND with" - " neither %<P%> nor %<R%> argument at %L", + " neither %<P%> nor %<R%> argument at %L", gfc_current_intrinsic_where)) return false; @@ -4074,7 +4209,7 @@ gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix) return false; if (!gfc_notify_std (GFC_STD_F2008, "%qs intrinsic with " - "RADIX argument at %L", gfc_current_intrinsic, + "RADIX argument at %L", gfc_current_intrinsic, &radix->where)) return false; } @@ -4116,7 +4251,7 @@ gfc_check_shape (gfc_expr *source, gfc_expr *kind) if (!kind_check (kind, 1, BT_INTEGER)) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -4171,7 +4306,7 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) if (!kind_check (kind, 2, BT_INTEGER)) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -4278,7 +4413,7 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr) } if (expr->ts.u.cl && expr->ts.u.cl->length - && !gfc_simplify_expr (expr, 0)) + && !gfc_simplify_expr (expr->ts.u.cl->length, 0)) gfc_internal_error ("is_c_interoperable(): gfc_simplify_expr failed"); if (!c_loc && expr->ts.u.cl @@ -4614,9 +4749,9 @@ gfc_check_c_loc (gfc_expr *x) &x->where); return false; } - + if (x->rank - && !gfc_notify_std (GFC_STD_F2008_TS, + && !gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable array at %L as" " argument to C_LOC: %s", &x->where, msg)) return false; @@ -4627,7 +4762,7 @@ gfc_check_c_loc (gfc_expr *x) if (ar->as->type != AS_EXPLICIT && ar->as->type != AS_ASSUMED_SIZE && !attr.allocatable - && !gfc_notify_std (GFC_STD_F2008, + && !gfc_notify_std (GFC_STD_F2008, "Array of interoperable type at %L " "to C_LOC which is nonallocatable and neither " "assumed size nor explicit size", &x->where)) @@ -4662,7 +4797,7 @@ gfc_check_sngl (gfc_expr *a) if ((a->ts.kind != gfc_default_double_kind) && !gfc_notify_std (GFC_STD_GNU, "non double precision " - "REAL argument to %s intrinsic at %L", + "REAL argument to %s intrinsic at %L", gfc_current_intrinsic, &a->where)) return false; @@ -5175,12 +5310,13 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) /* If we can't calculate the sizes, we cannot check any more. Return true for that case. */ - if (!gfc_calculate_transfer_sizes (source, mold, size, &source_size, + if (!gfc_calculate_transfer_sizes (source, mold, size, &source_size, &result_size, NULL)) return true; if (source_size < result_size) - gfc_warning (0, "Intrinsic TRANSFER at %L has partly undefined result: " + gfc_warning (OPT_Wsurprising, + "Intrinsic TRANSFER at %L has partly undefined result: " "source size %ld < result size %ld", &source->where, (long) source_size, (long) result_size); @@ -5213,7 +5349,7 @@ gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) if (!kind_check (kind, 2, BT_INTEGER)) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -5342,7 +5478,7 @@ gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind) if (!kind_check (kind, 3, BT_INTEGER)) return false; if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic " - "with KIND argument at %L", + "with KIND argument at %L", gfc_current_intrinsic, &kind->where)) return false; @@ -5520,16 +5656,14 @@ gfc_check_random_number (gfc_expr *harvest) bool gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) { - unsigned int nargs = 0, kiss_size; + unsigned int nargs = 0, seed_size; locus *where = NULL; mpz_t put_size, get_size; - bool have_gfc_real_16; /* Try and mimic HAVE_GFC_REAL_16 in libgfortran. */ - - have_gfc_real_16 = gfc_validate_kind (BT_REAL, 16, true) != -1; - /* Keep the number of bytes in sync with kiss_size in - libgfortran/intrinsics/random.c. */ - kiss_size = (have_gfc_real_16 ? 48 : 32) / gfc_default_integer_kind; + /* Keep the number of bytes in sync with master_state in + libgfortran/intrinsics/random.c. +1 due to the integer p which is + part of the state too. */ + seed_size = 128 / gfc_default_integer_kind + 1; if (size != NULL) { @@ -5572,11 +5706,11 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) return false; if (gfc_array_size (put, &put_size) - && mpz_get_ui (put_size) < kiss_size) + && mpz_get_ui (put_size) < seed_size) gfc_error ("Size of %qs argument of %qs intrinsic at %L " "too small (%i/%i)", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, - where, (int) mpz_get_ui (put_size), kiss_size); + where, (int) mpz_get_ui (put_size), seed_size); } if (get != NULL) @@ -5604,11 +5738,11 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) return false; if (gfc_array_size (get, &get_size) - && mpz_get_ui (get_size) < kiss_size) + && mpz_get_ui (get_size) < seed_size) gfc_error ("Size of %qs argument of %qs intrinsic at %L " "too small (%i/%i)", gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic, - where, (int) mpz_get_ui (get_size), kiss_size); + where, (int) mpz_get_ui (get_size), seed_size); } /* RANDOM_SEED may not have more than one non-optional argument. */ diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 3627828d21..2d72e9570d 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -1,5 +1,5 @@ /* Implementation of Fortran 2003 Polymorphism. - Copyright (C) 2009-2016 Free Software Foundation, Inc. + Copyright (C) 2009-2017 Free Software Foundation, Inc. Contributed by Paul Richard Thomas <pault@gcc.gnu.org> and Janus Weil <janus@gcc.gnu.org> @@ -224,7 +224,8 @@ gfc_add_component_ref (gfc_expr *e, const char *name) break; tail = &((*tail)->next); } - if (derived->components->next->ts.type == BT_DERIVED && + if (derived->components && derived->components->next && + derived->components->next->ts.type == BT_DERIVED && derived->components->next->ts.u.derived == NULL) { /* Fix up missing vtype. */ @@ -238,12 +239,14 @@ gfc_add_component_ref (gfc_expr *e, const char *name) /* Avoid losing memory. */ gfc_free_ref_list (*tail); c = gfc_find_component (derived, name, true, true, tail); - gcc_assert (c); - for (ref = *tail; ref->next; ref = ref->next) - ; - ref->next = next; - if (!next) - e->ts = c->ts; + + if (c) { + for (ref = *tail; ref->next; ref = ref->next) + ; + ref->next = next; + if (!next) + e->ts = c->ts; + } } @@ -257,7 +260,7 @@ gfc_add_class_array_ref (gfc_expr *e) int rank = CLASS_DATA (e)->as->rank; gfc_array_spec *as = CLASS_DATA (e)->as; gfc_ref *ref = NULL; - gfc_add_component_ref (e, "_data"); + gfc_add_data_component (e); e->rank = rank; for (ref = e->ref; ref; ref = ref->next) if (!ref->next) @@ -375,7 +378,8 @@ gfc_is_class_scalar_expr (gfc_expr *e) && CLASS_DATA (e->symtree->n.sym) && !CLASS_DATA (e->symtree->n.sym)->attr.dimension && (e->ref == NULL - || (strcmp (e->ref->u.c.component->name, "_data") == 0 + || (e->ref->type == REF_COMPONENT + && strcmp (e->ref->u.c.component->name, "_data") == 0 && e->ref->next == NULL))) return true; @@ -387,7 +391,8 @@ gfc_is_class_scalar_expr (gfc_expr *e) && CLASS_DATA (ref->u.c.component) && !CLASS_DATA (ref->u.c.component)->attr.dimension && (ref->next == NULL - || (strcmp (ref->next->u.c.component->name, "_data") == 0 + || (ref->next->type == REF_COMPONENT + && strcmp (ref->next->u.c.component->name, "_data") == 0 && ref->next->next == NULL))) return true; } @@ -582,7 +587,7 @@ gfc_get_len_component (gfc_expr *e) ref = ref->next; } /* And replace if with a ref to the _len component. */ - gfc_add_component_ref (ptr, "_len"); + gfc_add_len_component (ptr); return ptr; } @@ -705,7 +710,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, if (!gfc_add_component (fclass, "_len", &c)) return false; c->ts.type = BT_INTEGER; - c->ts.kind = 4; + c->ts.kind = gfc_charlen_int_kind; c->attr.access = ACCESS_PRIVATE; c->attr.artificial = 1; } @@ -746,7 +751,7 @@ add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb) { gfc_component *c; - if (tb->non_overridable) + if (tb->non_overridable && !tb->overridden) return; c = gfc_find_component (vtype, name, true, true, NULL); @@ -836,20 +841,19 @@ has_finalizer_component (gfc_symbol *derived) gfc_component *c; for (c = derived->components; c; c = c->next) - { - if (c->ts.type == BT_DERIVED && c->ts.u.derived->f2k_derived - && c->ts.u.derived->f2k_derived->finalizers) - return true; - - /* Stop infinite recursion through this function by inhibiting - calls when the derived type and that of the component are - the same. */ - if (c->ts.type == BT_DERIVED - && !gfc_compare_derived_types (derived, c->ts.u.derived) - && !c->attr.pointer && !c->attr.allocatable - && has_finalizer_component (c->ts.u.derived)) - return true; - } + if (c->ts.type == BT_DERIVED && !c->attr.pointer && !c->attr.allocatable) + { + if (c->ts.u.derived->f2k_derived + && c->ts.u.derived->f2k_derived->finalizers) + return true; + + /* Stop infinite recursion through this function by inhibiting + calls when the derived type and that of the component are + the same. */ + if (!gfc_compare_derived_types (derived, c->ts.u.derived) + && has_finalizer_component (c->ts.u.derived)) + return true; + } return false; } @@ -960,6 +964,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, cond->block = gfc_get_code (EXEC_IF); cond->block->expr1 = gfc_get_expr (); cond->block->expr1->expr_type = EXPR_FUNCTION; + cond->block->expr1->where = gfc_current_locus; gfc_get_sym_tree ("associated", sub_ns, &cond->block->expr1->symtree, false); cond->block->expr1->symtree->n.sym->attr.flavor = FL_PROCEDURE; cond->block->expr1->symtree->n.sym->attr.intrinsic = 1; @@ -1072,6 +1077,7 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr, gfc_commit_symbol (expr->symtree->n.sym); expr->ts.type = BT_INTEGER; expr->ts.kind = gfc_index_integer_kind; + expr->where = gfc_current_locus; /* TRANSFER. */ expr2 = gfc_build_intrinsic_call (sub_ns, GFC_ISYM_TRANSFER, "transfer", @@ -1088,6 +1094,7 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr, block->ext.actual->expr->value.op.op1 = expr2; block->ext.actual->expr->value.op.op2 = offset; block->ext.actual->expr->ts = expr->ts; + block->ext.actual->expr->where = gfc_current_locus; /* C_F_POINTER's 2nd arg: ptr -- and its absent shape=. */ block->ext.actual->next = gfc_get_actual_arglist (); @@ -1144,6 +1151,7 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, expr->ref->u.ar.dimen = 1; expr->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT; expr->ref->u.ar.start[0] = gfc_lval_expr_from_sym (idx2); + expr->where = sizes->declared_at; expr = gfc_build_intrinsic_call (sub_ns, GFC_ISYM_MOD, "mod", gfc_current_locus, 2, @@ -1164,6 +1172,7 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, expr2->value.op.op2->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT; expr2->value.op.op2->ref->u.ar.start[0] = gfc_get_expr (); expr2->value.op.op2->ref->u.ar.start[0]->expr_type = EXPR_OP; + expr2->value.op.op2->ref->u.ar.start[0]->where = gfc_current_locus; expr2->value.op.op2->ref->u.ar.start[0]->value.op.op = INTRINSIC_MINUS; expr2->value.op.op2->ref->u.ar.start[0]->value.op.op1 = gfc_lval_expr_from_sym (idx2); @@ -1172,6 +1181,7 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, expr2->value.op.op2->ref->u.ar.start[0]->ts = expr2->value.op.op2->ref->u.ar.start[0]->value.op.op1->ts; expr2->ts = idx->ts; + expr2->where = gfc_current_locus; /* ... * strides(idx2). */ expr = gfc_get_expr (); @@ -1187,6 +1197,7 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, expr->value.op.op2->ref->u.ar.start[0] = gfc_lval_expr_from_sym (idx2); expr->value.op.op2->ref->u.ar.as = strides->as; expr->ts = idx->ts; + expr->where = gfc_current_locus; /* offset = offset + ... */ block->block->next = gfc_get_code (EXEC_ASSIGN); @@ -1197,6 +1208,7 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, block->block->next->expr2->value.op.op1 = gfc_lval_expr_from_sym (offset); block->block->next->expr2->value.op.op2 = expr; block->block->next->expr2->ts = idx->ts; + block->block->next->expr2->where = gfc_current_locus; /* After the loop: offset = offset * byte_stride. */ block->next = gfc_get_code (EXEC_ASSIGN); @@ -1208,6 +1220,7 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset, block->expr2->value.op.op1 = gfc_lval_expr_from_sym (offset); block->expr2->value.op.op2 = gfc_lval_expr_from_sym (byte_stride); block->expr2->ts = block->expr2->value.op.op1->ts; + block->expr2->where = gfc_current_locus; return block; } @@ -1345,6 +1358,8 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, block->next->resolved_sym = fini->proc_tree->n.sym; block->next->ext.actual = gfc_get_actual_arglist (); block->next->ext.actual->expr = gfc_lval_expr_from_sym (array); + block->next->ext.actual->next = gfc_get_actual_arglist (); + block->next->ext.actual->next->expr = gfc_copy_expr (size_expr); /* ELSE. */ @@ -1415,6 +1430,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, /* Offset calculation for the new array: idx * size of type (in bytes). */ offset2 = gfc_get_expr (); offset2->expr_type = EXPR_OP; + offset2->where = gfc_current_locus; offset2->value.op.op = INTRINSIC_TIMES; offset2->value.op.op1 = gfc_lval_expr_from_sym (idx); offset2->value.op.op2 = gfc_copy_expr (size_expr); @@ -1597,6 +1613,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, final->attr.flavor = FL_PROCEDURE; final->attr.function = 1; final->attr.pure = 0; + final->attr.recursive = 1; final->result = final; final->ts.type = BT_INTEGER; final->ts.kind = 4; @@ -1819,6 +1836,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, block->expr2 = gfc_get_expr (); block->expr2->expr_type = EXPR_OP; block->expr2->value.op.op = INTRINSIC_TIMES; + block->expr2->where = gfc_current_locus; /* sizes(idx-1). */ block->expr2->value.op.op1 = gfc_lval_expr_from_sym (sizes); @@ -1830,6 +1848,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, block->expr2->value.op.op1->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT; block->expr2->value.op.op1->ref->u.ar.start[0] = gfc_get_expr (); block->expr2->value.op.op1->ref->u.ar.start[0]->expr_type = EXPR_OP; + block->expr2->value.op.op1->ref->u.ar.start[0]->where = gfc_current_locus; block->expr2->value.op.op1->ref->u.ar.start[0]->value.op.op = INTRINSIC_MINUS; block->expr2->value.op.op1->ref->u.ar.start[0]->value.op.op1 = gfc_lval_expr_from_sym (idx); @@ -1883,6 +1902,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, block->expr1->value.op.op2->ref->u.ar.dimen_type[0] = DIMEN_ELEMENT; block->expr1->value.op.op2->ref->u.ar.start[0] = gfc_get_expr (); block->expr1->value.op.op2->ref->u.ar.start[0]->expr_type = EXPR_OP; + block->expr1->value.op.op2->ref->u.ar.start[0]->where = gfc_current_locus; block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op = INTRINSIC_MINUS; block->expr1->value.op.op2->ref->u.ar.start[0]->value.op.op1 = gfc_lval_expr_from_sym (idx); @@ -1920,6 +1940,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, last_code->expr2->value.op.op2 = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1); last_code->expr2->ts = last_code->expr2->value.op.op2->ts; + last_code->expr2->where = gfc_current_locus; last_code->expr2->value.op.op1 = gfc_lval_expr_from_sym (sizes); last_code->expr2->value.op.op1->ref = gfc_get_ref (); @@ -2188,6 +2209,8 @@ gfc_find_derived_vtab (gfc_symbol *derived) gfc_namespace *ns; gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL; gfc_symbol *copy = NULL, *src = NULL, *dst = NULL; + gfc_gsymbol *gsym = NULL; + gfc_symbol *dealloc = NULL, *arg = NULL; /* Find the top-level namespace. */ for (ns = gfc_current_ns; ns; ns = ns->parent) @@ -2198,6 +2221,20 @@ gfc_find_derived_vtab (gfc_symbol *derived) if (!derived->attr.unlimited_polymorphic && derived->attr.is_class) derived = gfc_get_derived_super_type (derived); + /* Find the gsymbol for the module of use associated derived types. */ + if ((derived->attr.use_assoc || derived->attr.used_in_submodule) + && !derived->attr.vtype && !derived->attr.is_class) + gsym = gfc_find_gsymbol (gfc_gsym_root, derived->module); + else + gsym = NULL; + + /* Work in the gsymbol namespace if the top-level namespace is a module. + This ensures that the vtable is unique, which is required since we use + its address in SELECT TYPE. */ + if (gsym && gsym->ns && ns && ns->proc_name + && ns->proc_name->attr.flavor == FL_MODULE) + ns = gsym->ns; + if (ns) { char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1]; @@ -2206,7 +2243,14 @@ gfc_find_derived_vtab (gfc_symbol *derived) sprintf (name, "__vtab_%s", tname); /* Look for the vtab symbol in various namespaces. */ - gfc_find_symbol (name, gfc_current_ns, 0, &vtab); + if (gsym && gsym->ns) + { + gfc_find_symbol (name, gsym->ns, 0, &vtab); + if (vtab) + ns = gsym->ns; + } + if (vtab == NULL) + gfc_find_symbol (name, gfc_current_ns, 0, &vtab); if (vtab == NULL) gfc_find_symbol (name, ns, 0, &vtab); if (vtab == NULL) @@ -2231,6 +2275,20 @@ gfc_find_derived_vtab (gfc_symbol *derived) { gfc_component *c; gfc_symbol *parent = NULL, *parent_vtab = NULL; + bool rdt = false; + + /* Is this a derived type with recursive allocatable + components? */ + c = (derived->attr.unlimited_polymorphic + || derived->attr.abstract) ? + NULL : derived->components; + for (; c; c= c->next) + if (c->ts.type == BT_DERIVED + && c->ts.u.derived == derived) + { + rdt = true; + break; + } gfc_get_symbol (name, ns, &vtype); if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL, @@ -2403,6 +2461,66 @@ gfc_find_derived_vtab (gfc_symbol *derived) c->tb->ppc = 1; generate_finalization_wrapper (derived, ns, tname, c); + /* Add component _deallocate. */ + if (!gfc_add_component (vtype, "_deallocate", &c)) + goto cleanup; + c->attr.proc_pointer = 1; + c->attr.access = ACCESS_PRIVATE; + c->tb = XCNEW (gfc_typebound_proc); + c->tb->ppc = 1; + if (derived->attr.unlimited_polymorphic + || derived->attr.abstract + || !rdt) + c->initializer = gfc_get_null_expr (NULL); + else + { + /* Set up namespace. */ + gfc_namespace *sub_ns = gfc_get_namespace (ns, 0); + + sub_ns->sibling = ns->contained; + ns->contained = sub_ns; + sub_ns->resolved = 1; + /* Set up procedure symbol. */ + sprintf (name, "__deallocate_%s", tname); + gfc_get_symbol (name, sub_ns, &dealloc); + sub_ns->proc_name = dealloc; + dealloc->attr.flavor = FL_PROCEDURE; + dealloc->attr.subroutine = 1; + dealloc->attr.pure = 1; + dealloc->attr.artificial = 1; + dealloc->attr.if_source = IFSRC_DECL; + + if (ns->proc_name->attr.flavor == FL_MODULE) + dealloc->module = ns->proc_name->name; + gfc_set_sym_referenced (dealloc); + /* Set up formal argument. */ + gfc_get_symbol ("arg", sub_ns, &arg); + arg->ts.type = BT_DERIVED; + arg->ts.u.derived = derived; + arg->attr.flavor = FL_VARIABLE; + arg->attr.dummy = 1; + arg->attr.artificial = 1; + arg->attr.intent = INTENT_INOUT; + arg->attr.dimension = 1; + arg->attr.allocatable = 1; + arg->as = gfc_get_array_spec(); + arg->as->type = AS_ASSUMED_SHAPE; + arg->as->rank = 1; + arg->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind, + NULL, 1); + gfc_set_sym_referenced (arg); + dealloc->formal = gfc_get_formal_arglist (); + dealloc->formal->sym = arg; + /* Set up code. */ + sub_ns->code = gfc_get_code (EXEC_DEALLOCATE); + sub_ns->code->ext.alloc.list = gfc_get_alloc (); + sub_ns->code->ext.alloc.list->expr + = gfc_lval_expr_from_sym (arg); + /* Set initializer. */ + c->initializer = gfc_lval_expr_from_sym (dealloc); + c->ts.interface = dealloc; + } + /* Add procedure pointers for type-bound procedures. */ if (!derived->attr.unlimited_polymorphic) add_procs_to_declared_vtab (derived, vtype); @@ -2432,6 +2550,10 @@ cleanup: gfc_commit_symbol (src); if (dst) gfc_commit_symbol (dst); + if (dealloc) + gfc_commit_symbol (dealloc); + if (arg) + gfc_commit_symbol (arg); } else gfc_undo_symbols (); @@ -2491,11 +2613,6 @@ find_intrinsic_vtab (gfc_typespec *ts) gfc_namespace *ns; gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL; gfc_symbol *copy = NULL, *src = NULL, *dst = NULL; - int charlen = 0; - - if (ts->type == BT_CHARACTER && !ts->deferred && ts->u.cl && ts->u.cl->length - && ts->u.cl->length->expr_type == EXPR_CONSTANT) - charlen = mpz_get_si (ts->u.cl->length->value.integer); /* Find the top-level namespace. */ for (ns = gfc_current_ns; ns; ns = ns->parent) @@ -2506,12 +2623,10 @@ find_intrinsic_vtab (gfc_typespec *ts) { char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1]; - if (ts->type == BT_CHARACTER) - sprintf (tname, "%s_%d_%d", gfc_basic_typename (ts->type), - charlen, ts->kind); - else - sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind); - + /* Encode all types as TYPENAME_KIND_ including especially character + arrays, whose length is now consistently stored in the _len component + of the class-variable. */ + sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind); sprintf (name, "__vtab_%s", tname); /* Look for the vtab symbol in the top-level namespace only. */ @@ -2576,9 +2691,8 @@ find_intrinsic_vtab (gfc_typespec *ts) c->initializer = gfc_get_int_expr (gfc_default_integer_kind, NULL, ts->type == BT_CHARACTER - && charlen == 0 ? - ts->kind : - (int)gfc_element_size (e)); + ? ts->kind + : (int)gfc_element_size (e)); gfc_free_expr (e); /* Add component _extends. */ @@ -2865,15 +2979,6 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, bool* t, gfc_symtree* gfc_get_tbp_symtree (gfc_symtree **root, const char *name) { - gfc_symtree *result; - - result = gfc_find_symtree (*root, name); - if (!result) - { - result = gfc_new_symtree (root, name); - gcc_assert (result); - result->n.tb = NULL; - } - - return result; + gfc_symtree *result = gfc_find_symtree (*root, name); + return result ? result : gfc_new_symtree (root, name); } diff --git a/gcc/fortran/config-lang.in b/gcc/fortran/config-lang.in index b81dadd3ad..10caf50a53 100644 --- a/gcc/fortran/config-lang.in +++ b/gcc/fortran/config-lang.in @@ -1,4 +1,4 @@ -# Copyright (C) 2004-2016 Free Software Foundation, Inc. +# Copyright (C) 2004-2017 Free Software Foundation, Inc. # # This file is part of GCC. # diff --git a/gcc/fortran/constructor.c b/gcc/fortran/constructor.c index f2bf674ff4..35ea483b36 100644 --- a/gcc/fortran/constructor.c +++ b/gcc/fortran/constructor.c @@ -1,5 +1,5 @@ /* Array and structure constructors - Copyright (C) 2009-2016 Free Software Foundation, Inc. + Copyright (C) 2009-2017 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/constructor.h b/gcc/fortran/constructor.h index fb003b1a07..dd4f5ffb20 100644 --- a/gcc/fortran/constructor.h +++ b/gcc/fortran/constructor.h @@ -1,5 +1,5 @@ /* Array and structure constructors - Copyright (C) 2009-2016 Free Software Foundation, Inc. + Copyright (C) 2009-2017 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/convert.c b/gcc/fortran/convert.c index 128d915f20..35203235e8 100644 --- a/gcc/fortran/convert.c +++ b/gcc/fortran/convert.c @@ -1,5 +1,5 @@ /* Data type conversion - Copyright (C) 1987-2016 Free Software Foundation, Inc. + Copyright (C) 1987-2017 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c index 8ac8092687..6ac37ad856 100644 --- a/gcc/fortran/cpp.c +++ b/gcc/fortran/cpp.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2008-2016 Free Software Foundation, Inc. +/* Copyright (C) 2008-2017 Free Software Foundation, Inc. This file is part of GCC. @@ -168,7 +168,7 @@ cpp_define_builtins (cpp_reader *pfile) cpp_define (pfile, "_OPENACC=201306"); if (flag_openmp) - cpp_define (pfile, "_OPENMP=201307"); + cpp_define (pfile, "_OPENMP=201511"); /* The defines below are necessary for the TARGET_* macros. diff --git a/gcc/fortran/cpp.h b/gcc/fortran/cpp.h index 91b4714446..2bc3464390 100644 --- a/gcc/fortran/cpp.h +++ b/gcc/fortran/cpp.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2008-2016 Free Software Foundation, Inc. +/* Copyright (C) 2008-2017 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 139ce88053..184e53d480 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -1,5 +1,5 @@ /* Supporting functions for resolving DATA statement. - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Lifang Zeng <zlf605@hotmail.com> This file is part of GCC. @@ -483,7 +483,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, if (ref || last_ts->type == BT_CHARACTER) { - if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL)) + /* An initializer has to be constant. */ + if (rvalue->expr_type != EXPR_CONSTANT + || (lvalue->ts.u.cl->length == NULL + && !(ref && ref->u.ss.length != NULL))) return false; expr = create_character_initializer (init, last_ts, ref, rvalue); } diff --git a/gcc/fortran/data.h b/gcc/fortran/data.h index b3e4e9c7fb..98a5823cda 100644 --- a/gcc/fortran/data.h +++ b/gcc/fortran/data.h @@ -1,5 +1,5 @@ /* Header for functions resolving DATA statements. - Copyright (C) 2007-2016 Free Software Foundation, Inc. + Copyright (C) 2007-2017 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index da33b22610..5ca664e57a 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1,5 +1,5 @@ /* Declaration statement matcher - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -395,6 +395,7 @@ match_data_constant (gfc_expr **result) { gfc_error ("Symbol %qs must be a PARAMETER in DATA statement at %C", name); + *result = NULL; return MATCH_ERROR; } else if (dt_sym && gfc_fl_struct (dt_sym->attr.flavor)) @@ -608,10 +609,10 @@ cleanup: /* Like gfc_match_init_expr, but matches a 'clist' (old-style initialization list). The difference here is the expression is a list of constants - and is surrounded by '/'. + and is surrounded by '/'. The typespec ts must match the typespec of the variable which the clist is initializing. - The arrayspec tells whether this should match a list of constants + The arrayspec tells whether this should match a list of constants corresponding to array elements or a scalar (as == NULL). */ static match @@ -905,6 +906,7 @@ char_len_param_value (gfc_expr **expr, bool *deferred) goto syntax; else if ((*expr)->expr_type == EXPR_VARIABLE) { + bool t; gfc_expr *e; e = gfc_copy_expr (*expr); @@ -916,7 +918,17 @@ char_len_param_value (gfc_expr **expr, bool *deferred) && e->ref->u.ar.dimen_type[0] == DIMEN_RANGE) goto syntax; - gfc_reduce_init_expr (e); + t = gfc_reduce_init_expr (e); + + if (!t && e->ts.type == BT_UNKNOWN + && e->symtree->n.sym->attr.untyped == 1 + && (flag_implicit_none + || e->symtree->n.sym->ns->seen_implicit_none == 1 + || e->symtree->n.sym->ns->parent->seen_implicit_none == 1)) + { + gfc_free_expr (e); + goto syntax; + } if ((e->ref && e->ref->type == REF_ARRAY && e->ref->u.ar.type != AR_ELEMENT) @@ -1108,12 +1120,12 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) { /* Create a partially populated interface symbol to carry the characteristics of the procedure and the result. */ - sym->ts.interface = gfc_new_symbol (name, sym->ns); - gfc_add_type (sym->ts.interface, &(sym->ts), + sym->tlink = gfc_new_symbol (name, sym->ns); + gfc_add_type (sym->tlink, &(sym->ts), &gfc_current_locus); - gfc_copy_attr (&sym->ts.interface->attr, &sym->attr, NULL); + gfc_copy_attr (&sym->tlink->attr, &sym->attr, NULL); if (sym->attr.dimension) - sym->ts.interface->as = gfc_copy_array_spec (sym->as); + sym->tlink->as = gfc_copy_array_spec (sym->as); /* Ideally, at this point, a copy would be made of the formal arguments and their namespace. However, this does not appear @@ -1122,12 +1134,12 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) if (sym->result && sym->result != sym) { - sym->ts.interface->result = sym->result; + sym->tlink->result = sym->result; sym->result = NULL; } else if (sym->result) { - sym->ts.interface->result = sym->ts.interface; + sym->tlink->result = sym->tlink; } } else if (sym && !sym->gfc_new @@ -1485,11 +1497,15 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len) gfc_char_t *s; int slen; - gcc_assert (expr->expr_type == EXPR_CONSTANT); - if (expr->ts.type != BT_CHARACTER) return; + if (expr->expr_type != EXPR_CONSTANT) + { + gfc_error_now ("CHARACTER length must be a constant at %L", &expr->where); + return; + } + slen = expr->value.character.length; if (len != slen) { @@ -1657,7 +1673,18 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) else if (init->expr_type == EXPR_ARRAY) { if (init->ts.u.cl) - clen = mpz_get_si (init->ts.u.cl->length->value.integer); + { + const gfc_expr *length = init->ts.u.cl->length; + if (length->expr_type != EXPR_CONSTANT) + { + gfc_error ("Cannot initialize parameter array " + "at %L " + "with variable length elements", + &sym->declared_at); + return false; + } + clen = mpz_get_si (length->value.integer); + } else if (init->value.constructor) { gfc_constructor *c; @@ -1824,7 +1851,6 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, { gfc_state_data *s; gfc_component *c; - bool t = true; /* F03:C438/C439. If the current symbol is of the same derived type that we're constructing, it must have the pointer attribute. */ @@ -1832,7 +1858,25 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, && current_ts.u.derived == gfc_current_block () && current_attr.pointer == 0) { - gfc_error ("Component at %C must have the POINTER attribute"); + if (current_attr.allocatable + && !gfc_notify_std(GFC_STD_F2008, "Component at %C " + "must have the POINTER attribute")) + { + return false; + } + else if (current_attr.allocatable == 0) + { + gfc_error ("Component at %C must have the POINTER attribute"); + return false; + } + } + + /* F03:C437. */ + if (current_ts.type == BT_CLASS + && !(current_attr.pointer || current_attr.allocatable)) + { + gfc_error ("Component %qs with CLASS at %C must be allocatable " + "or pointer", name); return false; } @@ -1848,7 +1892,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, /* If we are in a nested union/map definition, gfc_add_component will not properly find repeated components because: - (i) gfc_add_component does a flat search, where components of unions + (i) gfc_add_component does a flat search, where components of unions and maps are implicity chained so nested components may conflict. (ii) Unions and maps are not linked as components of their parent structures until after they are parsed. @@ -1864,7 +1908,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, c = gfc_find_component (s->sym, name, true, true, NULL); if (c != NULL) { - gfc_error_now ("Component '%s' at %C already declared at %L", + gfc_error_now ("Component %qs at %C already declared at %L", name, &c->loc); return false; } @@ -1896,51 +1940,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, } *as = NULL; - /* Should this ever get more complicated, combine with similar section - in add_init_expr_to_sym into a separate function. */ - if (c->ts.type == BT_CHARACTER && !c->attr.pointer && c->initializer - && c->ts.u.cl - && c->ts.u.cl->length && c->ts.u.cl->length->expr_type == EXPR_CONSTANT) - { - int len; - - gcc_assert (c->ts.u.cl && c->ts.u.cl->length); - gcc_assert (c->ts.u.cl->length->expr_type == EXPR_CONSTANT); - gcc_assert (c->ts.u.cl->length->ts.type == BT_INTEGER); - - len = mpz_get_si (c->ts.u.cl->length->value.integer); - - if (c->initializer->expr_type == EXPR_CONSTANT) - gfc_set_constant_character_len (len, c->initializer, -1); - else if (mpz_cmp (c->ts.u.cl->length->value.integer, - c->initializer->ts.u.cl->length->value.integer)) - { - gfc_constructor *ctor; - ctor = gfc_constructor_first (c->initializer->value.constructor); - - if (ctor) - { - int first_len; - bool has_ts = (c->initializer->ts.u.cl - && c->initializer->ts.u.cl->length_from_typespec); - - /* Remember the length of the first element for checking - that all elements *in the constructor* have the same - length. This need not be the length of the LHS! */ - gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT); - gcc_assert (ctor->expr->ts.type == BT_CHARACTER); - first_len = ctor->expr->value.character.length; - - for ( ; ctor; ctor = gfc_constructor_next (ctor)) - if (ctor->expr->expr_type == EXPR_CONSTANT) - { - gfc_set_constant_character_len (len, ctor->expr, - has_ts ? -1 : first_len); - ctor->expr->ts.u.cl->length = gfc_copy_expr (c->ts.u.cl->length); - } - } - } - } + gfc_apply_init (&c->ts, &c->attr, c->initializer); /* Check array components. */ if (!c->attr.dimension) @@ -1952,7 +1952,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, { gfc_error ("Pointer array component of structure at %C must have a " "deferred shape"); - t = false; + return false; } } else if (c->attr.allocatable) @@ -1961,7 +1961,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, { gfc_error ("Allocatable component of structure at %C must have a " "deferred shape"); - t = false; + return false; } } else @@ -1970,20 +1970,15 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, { gfc_error ("Array component of structure at %C must have an " "explicit shape"); - t = false; + return false; } } scalar: if (c->ts.type == BT_CLASS) - { - bool t2 = gfc_build_class_symbol (&c->ts, &c->attr, &c->as); + return gfc_build_class_symbol (&c->ts, &c->attr, &c->as); - if (t) - t = t2; - } - - return t; + return true; } @@ -2545,7 +2540,6 @@ gfc_match_kind_spec (gfc_typespec *ts, bool kind_expr_only) gfc_expr *e; match m, n; char c; - const char *msg; m = MATCH_NO; n = MATCH_YES; @@ -2603,11 +2597,8 @@ kind_expr: goto no_match; } - msg = gfc_extract_int (e, &ts->kind); - - if (msg != NULL) + if (gfc_extract_int (e, &ts->kind, 1)) { - gfc_error (msg); m = MATCH_ERROR; goto no_match; } @@ -2705,7 +2696,7 @@ match_char_kind (int * kind, int * is_iso_c) locus where; gfc_expr *e; match m, n; - const char *msg; + bool fail; m = MATCH_NO; e = NULL; @@ -2735,11 +2726,10 @@ match_char_kind (int * kind, int * is_iso_c) goto no_match; } - msg = gfc_extract_int (e, kind); + fail = gfc_extract_int (e, kind, 1); *is_iso_c = e->ts.is_iso_c; - if (msg != NULL) + if (fail) { - gfc_error (msg); m = MATCH_ERROR; goto no_match; } @@ -2938,31 +2928,36 @@ done: /* Matches a RECORD declaration. */ static match -match_record_decl (const char *name) +match_record_decl (char *name) { locus old_loc; old_loc = gfc_current_locus; + match m; - if (gfc_match (" record") == MATCH_YES) + m = gfc_match (" record /"); + if (m == MATCH_YES) { - if (!gfc_option.flag_dec_structure) + if (!flag_dec_structure) { gfc_current_locus = old_loc; gfc_error ("RECORD at %C is an extension, enable it with " "-fdec-structure"); return MATCH_ERROR; } - if (gfc_match (" /%n/", name) != MATCH_YES) - { - gfc_error ("Structure name expected after RECORD at %C"); - gfc_current_locus = old_loc; - return MATCH_ERROR; - } - return MATCH_YES; + m = gfc_match (" %n/", name); + if (m == MATCH_YES) + return MATCH_YES; } - gfc_current_locus = old_loc; + gfc_current_locus = old_loc; + if (flag_dec_structure + && (gfc_match (" record% ") == MATCH_YES + || gfc_match (" record%t") == MATCH_YES)) + gfc_error ("Structure name expected after RECORD at %C"); + if (m == MATCH_NO) return MATCH_NO; + + return MATCH_ERROR; } /* Matches a declaration-type-spec (F03:R502). If successful, sets the ts @@ -3143,7 +3138,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) * don't need all the extra derived-type stuff for structures. */ if (gfc_find_symbol (gfc_dt_upper_string (name), NULL, 1, &sym)) { - gfc_error ("Type name '%s' at %C is ambiguous", name); + gfc_error ("Type name %qs at %C is ambiguous", name); return MATCH_ERROR; } if (sym && sym->attr.flavor == FL_STRUCT) @@ -3157,26 +3152,26 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) else { /* Match nested STRUCTURE declarations; only valid within another - structure declaration. */ - m = gfc_match (" structure"); - if (m == MATCH_ERROR) - return MATCH_ERROR; - else if (m == MATCH_YES) - { - if ( gfc_current_state () != COMP_STRUCTURE - && gfc_current_state () != COMP_MAP) - return MATCH_ERROR; - - m = gfc_match_structure_decl (); - if (m == MATCH_YES) - { - /* gfc_new_block is updated by match_structure_decl. */ - ts->type = BT_DERIVED; - ts->u.derived = gfc_new_block; - return MATCH_YES; - } - return MATCH_ERROR; - } + structure declaration. */ + if (flag_dec_structure + && (gfc_current_state () == COMP_STRUCTURE + || gfc_current_state () == COMP_MAP)) + { + m = gfc_match (" structure"); + if (m == MATCH_YES) + { + m = gfc_match_structure_decl (); + if (m == MATCH_YES) + { + /* gfc_new_block is updated by match_structure_decl. */ + ts->type = BT_DERIVED; + ts->u.derived = gfc_new_block; + return MATCH_YES; + } + } + if (m == MATCH_ERROR) + return MATCH_ERROR; + } /* Match CLASS declarations. */ m = gfc_match (" class ( * )"); @@ -3202,13 +3197,11 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) upe->attr.zero_comp = 1; if (!gfc_add_flavor (&upe->attr, FL_DERIVED, NULL, &gfc_current_locus)) - return MATCH_ERROR; - } + return MATCH_ERROR; + } else { - st = gfc_find_symtree (gfc_current_ns->sym_root, "STAR"); - if (st == NULL) - st = gfc_new_symtree (&gfc_current_ns->sym_root, "STAR"); + st = gfc_get_tbp_symtree (&gfc_current_ns->sym_root, "STAR"); st->n.sym = upe; upe->refs++; } @@ -3304,7 +3297,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) /* Use upper case to save the actual derived-type symbol. */ gfc_get_symbol (dt_name, NULL, &dt_sym); - dt_sym->name = gfc_get_string (sym->name); + dt_sym->name = gfc_get_string ("%s", sym->name); head = sym->generic; intr = gfc_get_interface (); intr->sym = dt_sym; @@ -3824,6 +3817,7 @@ match_attr_spec (void) DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL, DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL, DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE, + DECL_STATIC, DECL_AUTOMATIC, DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE, DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS, DECL_CONTIGUOUS, DECL_NONE, GFC_DECL_END /* Sentinel */ @@ -3887,6 +3881,14 @@ match_attr_spec (void) d = DECL_ASYNCHRONOUS; } break; + + case 'u': + if (match_string_p ("tomatic")) + { + /* Matched "automatic". */ + d = DECL_AUTOMATIC; + } + break; } break; @@ -3911,6 +3913,7 @@ match_attr_spec (void) d = DECL_CODIMENSION; break; } + /* FALLTHRU */ case 'n': if (match_string_p ("tiguous")) { @@ -4015,8 +4018,25 @@ match_attr_spec (void) break; case 's': - if (match_string_p ("save")) - d = DECL_SAVE; + gfc_next_ascii_char (); + switch (gfc_next_ascii_char ()) + { + case 'a': + if (match_string_p ("ve")) + { + /* Matched "save". */ + d = DECL_SAVE; + } + break; + + case 't': + if (match_string_p ("atic")) + { + /* Matched "static". */ + d = DECL_STATIC; + } + break; + } break; case 't': @@ -4153,6 +4173,12 @@ match_attr_spec (void) case DECL_SAVE: attr = "SAVE"; break; + case DECL_STATIC: + attr = "STATIC"; + break; + case DECL_AUTOMATIC: + attr = "AUTOMATIC"; + break; case DECL_TARGET: attr = "TARGET"; break; @@ -4181,6 +4207,18 @@ match_attr_spec (void) if (seen[d] == 0) continue; + if ((d == DECL_STATIC || d == DECL_AUTOMATIC) + && !flag_dec_static) + { + gfc_error ("%s at %L is a DEC extension, enable with -fdec-static", + d == DECL_STATIC ? "STATIC" : "AUTOMATIC", &seen_at[d]); + m = MATCH_ERROR; + goto cleanup; + } + /* Allow SAVE with STATIC, but don't complain. */ + if (d == DECL_STATIC && seen[DECL_SAVE]) + continue; + if (gfc_current_state () == COMP_DERIVED && d != DECL_DIMENSION && d != DECL_CODIMENSION && d != DECL_POINTER && d != DECL_PRIVATE @@ -4319,10 +4357,15 @@ match_attr_spec (void) &seen_at[d]); break; + case DECL_STATIC: case DECL_SAVE: t = gfc_add_save (¤t_attr, SAVE_EXPLICIT, NULL, &seen_at[d]); break; + case DECL_AUTOMATIC: + t = gfc_add_automatic (¤t_attr, NULL, &seen_at[d]); + break; + case DECL_TARGET: t = gfc_add_target (¤t_attr, &seen_at[d]); break; @@ -4807,6 +4850,10 @@ gfc_match_data_decl (void) if (current_attr.pointer && gfc_comp_struct (gfc_current_state ())) goto ok; + if (current_attr.allocatable && gfc_current_state () == COMP_DERIVED + && current_ts.u.derived == gfc_current_block ()) + goto ok; + gfc_find_symbol (current_ts.u.derived->name, current_ts.u.derived->ns, 1, &sym); @@ -4851,7 +4898,28 @@ ok: } if (!gfc_error_flag_test ()) - gfc_error ("Syntax error in data declaration at %C"); + { + /* An anonymous structure declaration is unambiguous; if we matched one + according to gfc_match_structure_decl, we need to return MATCH_YES + here to avoid confusing the remaining matchers, even if there was an + error during variable_decl. We must flush any such errors. Note this + causes the parser to gracefully continue parsing the remaining input + as a structure body, which likely follows. */ + if (current_ts.type == BT_DERIVED && current_ts.u.derived + && gfc_fl_struct (current_ts.u.derived->attr.flavor)) + { + gfc_error_now ("Syntax error in anonymous structure declaration" + " at %C"); + /* Skip the bad variable_decl and line up for the start of the + structure body. */ + gfc_error_recovery (); + m = MATCH_YES; + goto cleanup; + } + + gfc_error ("Syntax error in data declaration at %C"); + } + m = MATCH_ERROR; gfc_free_data_all (gfc_current_ns); @@ -4997,7 +5065,7 @@ copy_prefix (symbol_attribute *dest, locus *where) { gfc_error ("ELEMENTAL prefix in MODULE PROCEDURE interface is " "missing at %L", where); - return false; + return false; } if (dest->pure && !current_attr.pure) @@ -5362,6 +5430,7 @@ add_hidden_procptr_result (gfc_symbol *sym) gfc_get_sym_tree ("ppr@", gfc_current_ns->parent, &stree, false); st2 = gfc_new_symtree (&gfc_current_ns->sym_root, "ppr@"); st2->n.sym = stree->n.sym; + stree->n.sym->refs++; } sym->result = stree->n.sym; @@ -5454,7 +5523,8 @@ match_procedure_interface (gfc_symbol **proc_if) /* Resolve interface if possible. That way, attr.procedure is only set if it is declared by a later procedure-declaration-stmt, which is invalid per F08:C1216 (cf. resolve_procedure_interface). */ - while ((*proc_if)->ts.interface) + while ((*proc_if)->ts.interface + && *proc_if != (*proc_if)->ts.interface) *proc_if = (*proc_if)->ts.interface; if ((*proc_if)->attr.flavor == FL_UNKNOWN @@ -5990,7 +6060,6 @@ gfc_match_function_decl (void) sym->result = result; } - /* Warn if this procedure has the same name as an intrinsic. */ do_warn_intrinsic_shadow (sym, true); @@ -6688,7 +6757,7 @@ gfc_match_end (gfc_statement *st) match m; gfc_namespace *parent_ns, *ns, *prev_ns; gfc_namespace **nsp; - bool abreviated_modproc_decl; + bool abreviated_modproc_decl = false; bool got_matching_end = false; old_loc = gfc_current_locus; @@ -6712,15 +6781,17 @@ gfc_match_end (gfc_statement *st) state = gfc_state_stack->previous->state; block_name = gfc_state_stack->previous->sym == NULL ? NULL : gfc_state_stack->previous->sym->name; + abreviated_modproc_decl = gfc_state_stack->previous->sym + && gfc_state_stack->previous->sym->abr_modproc_decl; break; default: break; } - abreviated_modproc_decl - = gfc_current_block () - && gfc_current_block ()->abr_modproc_decl; + if (!abreviated_modproc_decl) + abreviated_modproc_decl = gfc_current_block () + && gfc_current_block ()->abr_modproc_decl; switch (state) { @@ -7054,7 +7125,7 @@ attr_decl1 (void) if (current_attr.dimension && sym->value) { gfc_error ("Dimensions specified for %s at %L after its " - "initialisation", sym->name, &var_locus); + "initialization", sym->name, &var_locus); m = MATCH_ERROR; goto cleanup; } @@ -7497,9 +7568,17 @@ access_attr_decl (gfc_statement st) goto syntax; case INTERFACE_GENERIC: + case INTERFACE_DTIO: + if (gfc_get_symbol (name, NULL, &sym)) goto done; + if (type == INTERFACE_DTIO + && gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.flavor == FL_MODULE + && sym->attr.flavor == FL_UNKNOWN) + sym->attr.flavor = FL_PROCEDURE; + if (!gfc_add_access (&sym->attr, (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE, @@ -7769,10 +7848,16 @@ cleanup: match gfc_match_parameter (void) { + const char *term = " )%t"; match m; if (gfc_match_char ('(') == MATCH_NO) - return MATCH_NO; + { + /* With legacy PARAMETER statements, don't expect a terminating ')'. */ + if (!gfc_notify_std (GFC_STD_LEGACY, "PARAMETER without '()' at %C")) + return MATCH_NO; + term = " %t"; + } for (;;) { @@ -7780,7 +7865,7 @@ gfc_match_parameter (void) if (m != MATCH_YES) break; - if (gfc_match (" )%t") == MATCH_YES) + if (gfc_match (term) == MATCH_YES) break; if (gfc_match_char (',') != MATCH_YES) @@ -7795,6 +7880,114 @@ gfc_match_parameter (void) } +match +gfc_match_automatic (void) +{ + gfc_symbol *sym; + match m; + bool seen_symbol = false; + + if (!flag_dec_static) + { + gfc_error ("AUTOMATIC at %C is a DEC extension, enable with " + "-fdec-static"); + return MATCH_ERROR; + } + + gfc_match (" ::"); + + for (;;) + { + m = gfc_match_symbol (&sym, 0); + switch (m) + { + case MATCH_NO: + break; + + case MATCH_ERROR: + return MATCH_ERROR; + + case MATCH_YES: + if (!gfc_add_automatic (&sym->attr, sym->name, &gfc_current_locus)) + return MATCH_ERROR; + seen_symbol = true; + break; + } + + if (gfc_match_eos () == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + + if (!seen_symbol) + { + gfc_error ("Expected entity-list in AUTOMATIC statement at %C"); + return MATCH_ERROR; + } + + return MATCH_YES; + +syntax: + gfc_error ("Syntax error in AUTOMATIC statement at %C"); + return MATCH_ERROR; +} + + +match +gfc_match_static (void) +{ + gfc_symbol *sym; + match m; + bool seen_symbol = false; + + if (!flag_dec_static) + { + gfc_error ("STATIC at %C is a DEC extension, enable with -fdec-static"); + return MATCH_ERROR; + } + + gfc_match (" ::"); + + for (;;) + { + m = gfc_match_symbol (&sym, 0); + switch (m) + { + case MATCH_NO: + break; + + case MATCH_ERROR: + return MATCH_ERROR; + + case MATCH_YES: + if (!gfc_add_save (&sym->attr, SAVE_EXPLICIT, sym->name, + &gfc_current_locus)) + return MATCH_ERROR; + seen_symbol = true; + break; + } + + if (gfc_match_eos () == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + + if (!seen_symbol) + { + gfc_error ("Expected entity-list in STATIC statement at %C"); + return MATCH_ERROR; + } + + return MATCH_YES; + +syntax: + gfc_error ("Syntax error in STATIC statement at %C"); + return MATCH_ERROR; +} + + /* Save statements have a special syntax. */ match @@ -8066,11 +8259,11 @@ gfc_match_submod_proc (void) /* Make sure that the result field is appropriately filled, even though the result symbol will be replaced later on. */ - if (sym->ts.interface && sym->ts.interface->attr.function) + if (sym->tlink && sym->tlink->attr.function) { - if (sym->ts.interface->result - && sym->ts.interface->result != sym->ts.interface) - sym->result= sym->ts.interface->result; + if (sym->tlink->result + && sym->tlink->result != sym->tlink) + sym->result= sym->tlink->result; else sym->result = sym; } @@ -8366,7 +8559,7 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name) does NOT have a generic symbol matching the name given by the user. STRUCTUREs can share names with variables and PARAMETERs so we must allow for the creation of an independent symbol. - Other parameters are a message to prefix errors with, the name of the new + Other parameters are a message to prefix errors with, the name of the new type to be created, and the flavor to add to the resulting symbol. */ static bool @@ -8394,7 +8587,7 @@ get_struct_decl (const char *name, sym_flavor fl, locus *decl, if (sym->components != NULL || sym->attr.zero_comp) { - gfc_error ("Type definition of '%s' at %C was already defined at %L", + gfc_error ("Type definition of %qs at %C was already defined at %L", sym->name, &sym->declared_at); return false; } @@ -8431,31 +8624,31 @@ get_struct_decl (const char *name, sym_flavor fl, locus *decl, match gfc_match_map (void) { - /* Counter used to give unique internal names to map structures. */ - static unsigned int gfc_map_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; - gfc_symbol *sym; - locus old_loc; + /* Counter used to give unique internal names to map structures. */ + static unsigned int gfc_map_id = 0; + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol *sym; + locus old_loc; - old_loc = gfc_current_locus; + old_loc = gfc_current_locus; - if (gfc_match_eos () != MATCH_YES) - { - gfc_error ("Junk after MAP statement at %C"); - gfc_current_locus = old_loc; - return MATCH_ERROR; - } + if (gfc_match_eos () != MATCH_YES) + { + gfc_error ("Junk after MAP statement at %C"); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } - /* Map blocks are anonymous so we make up unique names for the symbol table - which are invalid Fortran identifiers. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "MM$%u", gfc_map_id++); + /* Map blocks are anonymous so we make up unique names for the symbol table + which are invalid Fortran identifiers. */ + snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "MM$%u", gfc_map_id++); - if (!get_struct_decl (name, FL_STRUCT, &old_loc, &sym)) - return MATCH_ERROR; + if (!get_struct_decl (name, FL_STRUCT, &old_loc, &sym)) + return MATCH_ERROR; - gfc_new_block = sym; + gfc_new_block = sym; - return MATCH_YES; + return MATCH_YES; } @@ -8464,31 +8657,31 @@ gfc_match_map (void) match gfc_match_union (void) { - /* Counter used to give unique internal names to union types. */ - static unsigned int gfc_union_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; - gfc_symbol *sym; - locus old_loc; + /* Counter used to give unique internal names to union types. */ + static unsigned int gfc_union_id = 0; + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol *sym; + locus old_loc; - old_loc = gfc_current_locus; + old_loc = gfc_current_locus; - if (gfc_match_eos () != MATCH_YES) - { - gfc_error ("Junk after UNION statement at %C"); - gfc_current_locus = old_loc; - return MATCH_ERROR; - } + if (gfc_match_eos () != MATCH_YES) + { + gfc_error ("Junk after UNION statement at %C"); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } - /* Unions are anonymous so we make up unique names for the symbol table - which are invalid Fortran identifiers. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "UU$%u", gfc_union_id++); + /* Unions are anonymous so we make up unique names for the symbol table + which are invalid Fortran identifiers. */ + snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "UU$%u", gfc_union_id++); - if (!get_struct_decl (name, FL_UNION, &old_loc, &sym)) - return MATCH_ERROR; + if (!get_struct_decl (name, FL_UNION, &old_loc, &sym)) + return MATCH_ERROR; - gfc_new_block = sym; + gfc_new_block = sym; - return MATCH_YES; + return MATCH_YES; } @@ -8500,69 +8693,162 @@ gfc_match_union (void) match gfc_match_structure_decl (void) { - /* Counter used to give unique internal names to anonymous structures. */ - int gfc_structure_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; - gfc_symbol *sym; - match m; - locus where; + /* Counter used to give unique internal names to anonymous structures. */ + static unsigned int gfc_structure_id = 0; + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol *sym; + match m; + locus where; - if(!gfc_option.flag_dec_structure) - { - gfc_error ("STRUCTURE at %C is a DEC extension, enable with " - "-fdec-structure"); - return MATCH_ERROR; - } + if (!flag_dec_structure) + { + gfc_error ("STRUCTURE at %C is a DEC extension, enable with " + "-fdec-structure"); + return MATCH_ERROR; + } - name[0] = '\0'; + name[0] = '\0'; - m = gfc_match (" /%n/", name); - if (m != MATCH_YES) - { - /* Non-nested structure declarations require a structure name. */ - if (!gfc_comp_struct (gfc_current_state ())) - { - gfc_error ("Structure name expected in non-nested structure " - "declaration at %C"); - return MATCH_ERROR; - } - /* This is an anonymous structure; make up a unique name for it - (upper-case letters never make it to symbol names from the source). - The important thing is initializing the type variable - and setting gfc_new_symbol, which is immediately used by - parse_structure () and variable_decl () to add components of - this type. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "SS$%u", gfc_structure_id++); - } + m = gfc_match (" /%n/", name); + if (m != MATCH_YES) + { + /* Non-nested structure declarations require a structure name. */ + if (!gfc_comp_struct (gfc_current_state ())) + { + gfc_error ("Structure name expected in non-nested structure " + "declaration at %C"); + return MATCH_ERROR; + } + /* This is an anonymous structure; make up a unique name for it + (upper-case letters never make it to symbol names from the source). + The important thing is initializing the type variable + and setting gfc_new_symbol, which is immediately used by + parse_structure () and variable_decl () to add components of + this type. */ + snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "SS$%u", gfc_structure_id++); + } - where = gfc_current_locus; - /* No field list allowed after non-nested structure declaration. */ - if (!gfc_comp_struct (gfc_current_state ()) - && gfc_match_eos () != MATCH_YES) - { - gfc_error ("Junk after non-nested STRUCTURE statement at %C"); - return MATCH_ERROR; - } + where = gfc_current_locus; + /* No field list allowed after non-nested structure declaration. */ + if (!gfc_comp_struct (gfc_current_state ()) + && gfc_match_eos () != MATCH_YES) + { + gfc_error ("Junk after non-nested STRUCTURE statement at %C"); + return MATCH_ERROR; + } - /* Make sure the name is not the name of an intrinsic type. */ - if (gfc_is_intrinsic_typename (name)) - { - gfc_error ("Structure name '%s' at %C cannot be the same as an" - " intrinsic type", name); - return MATCH_ERROR; - } + /* Make sure the name is not the name of an intrinsic type. */ + if (gfc_is_intrinsic_typename (name)) + { + gfc_error ("Structure name %qs at %C cannot be the same as an" + " intrinsic type", name); + return MATCH_ERROR; + } - /* Store the actual type symbol for the structure with an upper-case first - letter (an invalid Fortran identifier). */ + /* Store the actual type symbol for the structure with an upper-case first + letter (an invalid Fortran identifier). */ - sprintf (name, gfc_dt_upper_string (name)); - if (!get_struct_decl (name, FL_STRUCT, &where, &sym)) - return MATCH_ERROR; + if (!get_struct_decl (gfc_dt_upper_string (name), FL_STRUCT, &where, &sym)) + return MATCH_ERROR; - gfc_new_block = sym; - return MATCH_YES; + gfc_new_block = sym; + return MATCH_YES; } + +/* This function does some work to determine which matcher should be used to + * match a statement beginning with "TYPE". This is used to disambiguate TYPE + * as an alias for PRINT from derived type declarations, TYPE IS statements, + * and derived type data declarations. */ + +match +gfc_match_type (gfc_statement *st) +{ + char name[GFC_MAX_SYMBOL_LEN + 1]; + match m; + locus old_loc; + + /* Requires -fdec. */ + if (!flag_dec) + return MATCH_NO; + + m = gfc_match ("type"); + if (m != MATCH_YES) + return m; + /* If we already have an error in the buffer, it is probably from failing to + * match a derived type data declaration. Let it happen. */ + else if (gfc_error_flag_test ()) + return MATCH_NO; + + old_loc = gfc_current_locus; + *st = ST_NONE; + + /* If we see an attribute list before anything else it's definitely a derived + * type declaration. */ + if (gfc_match (" ,") == MATCH_YES || gfc_match (" ::") == MATCH_YES) + { + gfc_current_locus = old_loc; + *st = ST_DERIVED_DECL; + return gfc_match_derived_decl (); + } + + /* By now "TYPE" has already been matched. If we do not see a name, this may + * be something like "TYPE *" or "TYPE <fmt>". */ + m = gfc_match_name (name); + if (m != MATCH_YES) + { + /* Let print match if it can, otherwise throw an error from + * gfc_match_derived_decl. */ + gfc_current_locus = old_loc; + if (gfc_match_print () == MATCH_YES) + { + *st = ST_WRITE; + return MATCH_YES; + } + gfc_current_locus = old_loc; + *st = ST_DERIVED_DECL; + return gfc_match_derived_decl (); + } + + /* A derived type declaration requires an EOS. Without it, assume print. */ + m = gfc_match_eos (); + if (m == MATCH_NO) + { + /* Check manually for TYPE IS (... - this is invalid print syntax. */ + if (strncmp ("is", name, 3) == 0 + && gfc_match (" (", name) == MATCH_YES) + { + gfc_current_locus = old_loc; + gcc_assert (gfc_match (" is") == MATCH_YES); + *st = ST_TYPE_IS; + return gfc_match_type_is (); + } + gfc_current_locus = old_loc; + *st = ST_WRITE; + return gfc_match_print (); + } + else + { + /* By now we have "TYPE <name> <EOS>". Check first if the name is an + * intrinsic typename - if so let gfc_match_derived_decl dump an error. + * Otherwise if gfc_match_derived_decl fails it's probably an existing + * symbol which can be printed. */ + gfc_current_locus = old_loc; + m = gfc_match_derived_decl (); + if (gfc_is_intrinsic_typename (name) || m == MATCH_YES) + { + *st = ST_DERIVED_DECL; + return m; + } + gfc_current_locus = old_loc; + *st = ST_WRITE; + return gfc_match_print (); + } + + return MATCH_NO; +} + + /* Match the beginning of a derived type declaration. If a type name was the result of a function, then it is possible to have a symbol already to be known as a derived type yet have no components. */ @@ -8655,7 +8941,7 @@ gfc_match_derived_decl (void) { /* Use upper case to save the actual derived-type symbol. */ gfc_get_symbol (gfc_dt_upper_string (gensym->name), NULL, &sym); - sym->name = gfc_get_string (gensym->name); + sym->name = gfc_get_string ("%s", gensym->name); head = gensym->generic; intr = gfc_get_interface (); intr->sym = sym; @@ -9075,7 +9361,7 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc) if (m == MATCH_ERROR) goto error; if (m == MATCH_YES) - ba->pass_arg = gfc_get_string (arg); + ba->pass_arg = gfc_get_string ("%s", arg); gcc_assert ((m == MATCH_YES) == (ba->pass_arg != NULL)); found_passing = true; @@ -9336,6 +9622,8 @@ match_procedure_in_type (void) false)) return MATCH_ERROR; gfc_set_sym_referenced (stree->n.tb->u.specific->n.sym); + gfc_add_flavor(&stree->n.tb->u.specific->n.sym->attr, FL_PROCEDURE, + target, &stree->n.tb->u.specific->n.sym->declared_at); if (gfc_match_eos () == MATCH_YES) return MATCH_YES; @@ -9406,6 +9694,7 @@ gfc_match_generic (void) switch (op_type) { case INTERFACE_GENERIC: + case INTERFACE_DTIO: snprintf (bind_name, sizeof (bind_name), "%s", name); break; @@ -9441,6 +9730,7 @@ gfc_match_generic (void) switch (op_type) { + case INTERFACE_DTIO: case INTERFACE_USER_OP: case INTERFACE_GENERIC: { @@ -9448,14 +9738,7 @@ gfc_match_generic (void) gfc_symtree* st; st = gfc_find_symtree (is_op ? ns->tb_uop_root : ns->tb_sym_root, name); - if (st) - { - tb = st->n.tb; - gcc_assert (tb); - } - else - tb = NULL; - + tb = st ? st->n.tb : NULL; break; } @@ -9495,14 +9778,13 @@ gfc_match_generic (void) switch (op_type) { + case INTERFACE_DTIO: case INTERFACE_GENERIC: case INTERFACE_USER_OP: { const bool is_op = (op_type == INTERFACE_USER_OP); - gfc_symtree* st; - - st = gfc_new_symtree (is_op ? &ns->tb_uop_root : &ns->tb_sym_root, - name); + gfc_symtree* st = gfc_get_tbp_symtree (is_op ? &ns->tb_uop_root : + &ns->tb_sym_root, name); gcc_assert (st); st->n.tb = tb; diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index f117de0364..1af2885c9e 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -1,5 +1,5 @@ /* Dependency analysis - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> This file is part of GCC. @@ -101,7 +101,9 @@ identical_array_ref (gfc_array_ref *a1, gfc_array_ref *a2) if (a1->type == AR_ELEMENT && a2->type == AR_ELEMENT) { - gcc_assert (a1->dimen == a2->dimen); + if (a1->dimen != a2->dimen) + gfc_internal_error ("identical_array_ref(): inconsistent dimensions"); + for (i = 0; i < a1->dimen; i++) { if (gfc_dep_compare_expr (a1->start[i], a2->start[i]) != 0) @@ -226,9 +228,26 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok) if ((args1->expr == NULL) ^ (args2->expr == NULL)) return -2; - if (args1->expr != NULL && args2->expr != NULL - && gfc_dep_compare_expr (args1->expr, args2->expr) != 0) - return -2; + if (args1->expr != NULL && args2->expr != NULL) + { + gfc_expr *e1, *e2; + e1 = args1->expr; + e2 = args2->expr; + + if (gfc_dep_compare_expr (e1, e2) != 0) + return -2; + + /* Special case: String arguments which compare equal can have + different lengths, which makes them different in calls to + procedures. */ + + if (e1->expr_type == EXPR_CONSTANT + && e1->ts.type == BT_CHARACTER + && e2->expr_type == EXPR_CONSTANT + && e2->ts.type == BT_CHARACTER + && e1->value.character.length != e2->value.character.length) + return -2; + } args1 = args1->next; args2 = args2->next; @@ -486,7 +505,6 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) case EXPR_FUNCTION: return gfc_dep_compare_functions (e1, e2, false); - break; default: return -2; @@ -1252,7 +1270,14 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical) gfc_constructor *c; int n; - gcc_assert (expr1->expr_type == EXPR_VARIABLE); + /* -fcoarray=lib can end up here with expr1->expr_type set to EXPR_FUNCTION + and a reference to _F.caf_get, so skip the assert. */ + if (expr1->expr_type == EXPR_FUNCTION + && strcmp (expr1->value.function.name, "_F.caf_get") == 0) + return 0; + + if (expr1->expr_type != EXPR_VARIABLE) + gfc_internal_error ("gfc_check_dependency: expecting an EXPR_VARIABLE"); switch (expr2->expr_type) { diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h index 6924d96dee..5a509340fe 100644 --- a/gcc/fortran/dependency.h +++ b/gcc/fortran/dependency.h @@ -1,5 +1,5 @@ /* Header for dependency analysis - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 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.c index 8c24074215..87a530458f 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1,5 +1,5 @@ /* Parse tree dumper - Copyright (C) 2003-2016 Free Software Foundation, Inc. + Copyright (C) 2003-2017 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. @@ -47,6 +47,7 @@ static FILE *dumpfile; static void show_expr (gfc_expr *p); static void show_code_node (int, gfc_code *); static void show_namespace (gfc_namespace *ns); +static void show_code (int, gfc_code *); /* Allow dumping of an expression in the debugger. */ @@ -62,6 +63,18 @@ gfc_debug_expr (gfc_expr *e) dumpfile = tmp; } +/* Allow for dumping of a piece of code in the debugger. */ +void gfc_debug_code (gfc_code *c); + +void +gfc_debug_code (gfc_code *c) +{ + FILE *tmp = dumpfile; + dumpfile = stderr; + show_code (1, c); + fputc ('\n', dumpfile); + dumpfile = tmp; +} /* Do indentation for a specific level. */ @@ -227,7 +240,7 @@ show_array_ref (gfc_array_ref * ar) print the start expression which contains the vector, in the latter case we have to print any of lower and upper bound and the stride, if they're present. */ - + if (ar->start[i] != NULL) show_expr (ar->start[i]); @@ -429,7 +442,7 @@ show_expr (gfc_expr *p) break; case BT_CHARACTER: - show_char_const (p->value.character.string, + show_char_const (p->value.character.string, p->value.character.length); break; @@ -982,7 +995,7 @@ show_common (gfc_symtree *st) fputs (", ", dumpfile); } fputc ('\n', dumpfile); -} +} /* Worker function to display the symbol tree. */ @@ -1059,6 +1072,27 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_DEPEND_IN: fputs ("in:", dumpfile); break; case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break; case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break; + case OMP_DEPEND_SINK_FIRST: + fputs ("sink:", dumpfile); + while (1) + { + fprintf (dumpfile, "%s", n->sym->name); + if (n->expr) + { + fputc ('+', dumpfile); + show_expr (n->expr); + } + if (n->next == NULL) + break; + else if (n->next->u.depend_op != OMP_DEPEND_SINK) + { + fputs (") DEPEND(", dumpfile); + break; + } + fputc (',', dumpfile); + n = n->next; + } + continue; default: break; } else if (list_type == OMP_LIST_MAP) @@ -1070,7 +1104,17 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break; default: break; } + else if (list_type == OMP_LIST_LINEAR) + switch (n->u.linear_op) + { + case OMP_LINEAR_REF: fputs ("ref(", dumpfile); break; + case OMP_LINEAR_VAL: fputs ("val(", dumpfile); break; + case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break; + default: break; + } fprintf (dumpfile, "%s", n->sym->name); + if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT) + fputc (')', dumpfile); if (n->expr) { fputc (':', dumpfile); @@ -1087,7 +1131,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) static void show_omp_clauses (gfc_omp_clauses *omp_clauses) { - int list_type; + int list_type, i; switch (omp_clauses->cancel) { @@ -1209,7 +1253,20 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) default: gcc_unreachable (); } - fprintf (dumpfile, " SCHEDULE (%s", type); + fputs (" SCHEDULE (", dumpfile); + if (omp_clauses->sched_simd) + { + if (omp_clauses->sched_monotonic + || omp_clauses->sched_nonmonotonic) + fputs ("SIMD, ", dumpfile); + else + fputs ("SIMD: ", dumpfile); + } + if (omp_clauses->sched_monotonic) + fputs ("MONOTONIC: ", dumpfile); + else if (omp_clauses->sched_nonmonotonic) + fputs ("NONMONOTONIC: ", dumpfile); + fputs (type, dumpfile); if (omp_clauses->chunk_size) { fputc (',', dumpfile); @@ -1238,7 +1295,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) for (list = omp_clauses->tile_list; list; list = list->next) { show_expr (list->expr); - if (list->next) + if (list->next) fputs (", ", dumpfile); } fputc (')', dumpfile); @@ -1250,7 +1307,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) for (list = omp_clauses->wait_list; list; list = list->next) { show_expr (list->expr); - if (list->next) + if (list->next) fputs (", ", dumpfile); } fputc (')', dumpfile); @@ -1260,7 +1317,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) if (omp_clauses->independent) fputs (" INDEPENDENT", dumpfile); if (omp_clauses->ordered) - fputs (" ORDERED", dumpfile); + { + if (omp_clauses->orderedc) + fprintf (dumpfile, " ORDERED(%d)", omp_clauses->orderedc); + else + fputs (" ORDERED", dumpfile); + } if (omp_clauses->untied) fputs (" UNTIED", dumpfile); if (omp_clauses->mergeable) @@ -1286,6 +1348,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_ALIGNED: type = "ALIGNED"; break; case OMP_LIST_LINEAR: type = "LINEAR"; break; case OMP_LIST_REDUCTION: type = "REDUCTION"; 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_DEPEND: type = "DEPEND"; break; default: gcc_unreachable (); @@ -1343,7 +1407,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE) { - fprintf (dumpfile, " DIST_SCHEDULE (static"); + fprintf (dumpfile, " DIST_SCHEDULE (STATIC"); if (omp_clauses->dist_chunk_size) { fputc (',', dumpfile); @@ -1351,6 +1415,59 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fputc (')', dumpfile); } + if (omp_clauses->defaultmap) + fputs (" DEFALTMAP (TOFROM: SCALAR)", dumpfile); + if (omp_clauses->nogroup) + fputs (" NOGROUP", dumpfile); + if (omp_clauses->simd) + fputs (" SIMD", dumpfile); + if (omp_clauses->threads) + fputs (" THREADS", dumpfile); + if (omp_clauses->grainsize) + { + fputs (" GRAINSIZE(", dumpfile); + show_expr (omp_clauses->grainsize); + fputc (')', dumpfile); + } + if (omp_clauses->hint) + { + fputs (" HINT(", dumpfile); + show_expr (omp_clauses->hint); + fputc (')', dumpfile); + } + if (omp_clauses->num_tasks) + { + fputs (" NUM_TASKS(", dumpfile); + show_expr (omp_clauses->num_tasks); + fputc (')', dumpfile); + } + if (omp_clauses->priority) + { + fputs (" PRIORITY(", dumpfile); + show_expr (omp_clauses->priority); + fputc (')', dumpfile); + } + for (i = 0; i < OMP_IF_LAST; i++) + if (omp_clauses->if_exprs[i]) + { + static const char *ifs[] = { + "PARALLEL", + "TASK", + "TASKLOOP", + "TARGET", + "TARGET DATA", + "TARGET UPDATE", + "TARGET ENTER DATA", + "TARGET EXIT DATA" + }; + fputs (" IF(", dumpfile); + fputs (ifs[i], dumpfile); + fputs (": ", dumpfile); + show_expr (omp_clauses->if_exprs[i]); + fputc (')', dumpfile); + } + if (omp_clauses->depend_source) + fputs (" DEPEND(source)", dumpfile); } /* Show a single OpenMP or OpenACC directive node and everything underneath it @@ -1365,7 +1482,8 @@ show_omp_node (int level, gfc_code *c) switch (c->op) { - case EXEC_OACC_PARALLEL_LOOP: name = "PARALLEL LOOP"; is_oacc = true; break; + case EXEC_OACC_PARALLEL_LOOP: + name = "PARALLEL LOOP"; is_oacc = true; break; case EXEC_OACC_PARALLEL: name = "PARALLEL"; is_oacc = true; break; case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; is_oacc = true; break; case EXEC_OACC_KERNELS: name = "KERNELS"; is_oacc = true; break; @@ -1382,9 +1500,15 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_CANCEL: name = "CANCEL"; break; case EXEC_OMP_CANCELLATION_POINT: name = "CANCELLATION POINT"; break; case EXEC_OMP_CRITICAL: name = "CRITICAL"; break; - case EXEC_OMP_FLUSH: name = "FLUSH"; break; + case EXEC_OMP_DISTRIBUTE: name = "DISTRIBUTE"; break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + name = "DISTRIBUTE PARALLEL DO"; break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "DISTRIBUTE PARALLEL DO SIMD"; break; + case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break; case EXEC_OMP_DO: name = "DO"; break; case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break; + case EXEC_OMP_FLUSH: name = "FLUSH"; break; case EXEC_OMP_MASTER: name = "MASTER"; break; case EXEC_OMP_ORDERED: name = "ORDERED"; break; case EXEC_OMP_PARALLEL: name = "PARALLEL"; break; @@ -1395,10 +1519,38 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_SECTIONS: name = "SECTIONS"; break; case EXEC_OMP_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; + case EXEC_OMP_TARGET: name = "TARGET"; break; + case EXEC_OMP_TARGET_DATA: name = "TARGET DATA"; break; + case EXEC_OMP_TARGET_ENTER_DATA: name = "TARGET ENTER DATA"; break; + case EXEC_OMP_TARGET_EXIT_DATA: name = "TARGET EXIT DATA"; break; + case EXEC_OMP_TARGET_PARALLEL: name = "TARGET PARALLEL"; break; + case EXEC_OMP_TARGET_PARALLEL_DO: name = "TARGET PARALLEL DO"; break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + name = "TARGET_PARALLEL_DO_SIMD"; break; + case EXEC_OMP_TARGET_SIMD: name = "TARGET SIMD"; break; + case EXEC_OMP_TARGET_TEAMS: name = "TARGET TEAMS"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + name = "TARGET TEAMS DISTRIBUTE"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "TARGET TEAMS DISTRIBUTE PARALLEL DO"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + name = "TARGET TEAMS DISTRIBUTE SIMD"; break; + case EXEC_OMP_TARGET_UPDATE: name = "TARGET UPDATE"; break; case EXEC_OMP_TASK: name = "TASK"; break; case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break; + case EXEC_OMP_TASKLOOP: name = "TASKLOOP"; break; + case EXEC_OMP_TASKLOOP_SIMD: name = "TASKLOOP SIMD"; break; case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break; case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break; + case EXEC_OMP_TEAMS: name = "TEAMS"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE: name = "TEAMS DISTRIBUTE"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "TEAMS DISTRIBUTE PARALLEL DO"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "TEAMS DISTRIBUTE PARALLEL DO SIMD"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: name = "TEAMS DISTRIBUTE SIMD"; break; case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; default: gcc_unreachable (); @@ -1420,23 +1572,50 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_EXIT_DATA: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: - case EXEC_OMP_WORKSHARE: - case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_WORKSHARE: omp_clauses = c->ext.omp_clauses; break; case EXEC_OMP_CRITICAL: - if (c->ext.omp_name) - fprintf (dumpfile, " (%s)", c->ext.omp_name); + omp_clauses = c->ext.omp_clauses; + if (omp_clauses) + fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name); break; case EXEC_OMP_FLUSH: if (c->ext.omp_namelist) @@ -1457,9 +1636,12 @@ show_omp_node (int level, gfc_code *c) show_omp_clauses (omp_clauses); fputc ('\n', dumpfile); - /* OpenACC executable directives don't have associated blocks. */ + /* OpenMP and OpenACC executable directives don't have associated blocks. */ if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE - || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA) + || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA + || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA + || c->op == EXEC_OMP_TARGET_EXIT_DATA + || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) return; if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) { @@ -1493,8 +1675,8 @@ show_omp_node (int level, gfc_code *c) else if (omp_clauses->nowait) fputs (" NOWAIT", dumpfile); } - else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name) - fprintf (dumpfile, " (%s)", c->ext.omp_name); + else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses) + fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name); } @@ -1636,6 +1818,10 @@ show_code_node (int level, gfc_code *c) break; + case EXEC_FAIL_IMAGE: + fputs ("FAIL IMAGE ", dumpfile); + break; + case EXEC_SYNC_ALL: fputs ("SYNC ALL ", dumpfile); if (c->expr2 != NULL) @@ -1815,8 +2001,12 @@ show_code_node (int level, gfc_code *c) break; case EXEC_SELECT: + case EXEC_SELECT_TYPE: d = c->block; - fputs ("SELECT CASE ", dumpfile); + if (c->op == EXEC_SELECT_TYPE) + fputs ("SELECT TYPE ", dumpfile); + else + fputs ("SELECT CASE ", dumpfile); show_expr (c->expr1); fputc ('\n', dumpfile); @@ -2516,9 +2706,13 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: - case EXEC_OMP_FLUSH: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_FLUSH: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: @@ -2529,10 +2723,31 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: show_omp_node (level, c); break; @@ -2628,7 +2843,7 @@ show_namespace (gfc_namespace *ns) fputs ("User operators:\n", dumpfile); gfc_traverse_user_op (ns, show_uop); } - + for (eq = ns->equiv; eq; eq = eq->next) show_equiv (eq); diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index 49ede5a71f..0312499f32 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -1,5 +1,5 @@ /* Handle errors. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught & Niels Kristian Bech Jensen This file is part of GCC. @@ -67,7 +67,7 @@ gfc_push_suppress_errors (void) } static void -gfc_error (const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(1,0); +gfc_error_opt (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0); static bool gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0); @@ -307,7 +307,7 @@ show_locus (locus *loc, int c1, int c2) error_string (f->filename); error_char (':'); - + error_integer (LOCATION_LINE (lb->location)); if ((c1 > 0) || (c2 > 0)) @@ -357,7 +357,7 @@ show_locus (locus *loc, int c1, int c2) offset = cmax - terminal_width + 5; /* Show the line itself, taking care not to print more than what can - show up on the terminal. Tabs are converted to spaces, and + show up on the terminal. Tabs are converted to spaces, and nonprintable characters are converted to a "\xNN" sequence. */ p = &(lb->line[offset]); @@ -375,7 +375,7 @@ show_locus (locus *loc, int c1, int c2) error_char ('\n'); /* Show the '1' and/or '2' corresponding to the column of the error - locus. Note that a value of -1 for c1 or c2 will simply cause + locus. Note that a value of -1 for c1 or c2 will simply cause the relevant number not to be printed. */ c1 -= offset; @@ -440,7 +440,7 @@ show_loci (locus *l1, locus *l2) else m = c1 - c2; - /* Note that the margin value of 10 here needs to be less than the + /* Note that the margin value of 10 here needs to be less than the margin of 5 used in the calculation of offset in show_locus. */ if (l1->lb != l2->lb || m > terminal_width - 10) @@ -467,11 +467,11 @@ show_loci (locus *l1, locus *l2) If a locus pointer is given, the actual source line is printed out and the column is indicated. Since we want the error message at the bottom of any source file information, we must scan the - argument list twice -- once to determine whether the loci are + argument list twice -- once to determine whether the loci are present and record this for printing, and once to print the error message after and loci have been printed. A maximum of two locus arguments are permitted. - + This function is also called (recursively) by show_locus in the case of included files; however, as show_locus does not resupply any loci, the recursion is at most one level deep. */ @@ -687,11 +687,11 @@ error_print (const char *type, const char *format0, va_list argp) /* This is a position specifier. See comment above. */ while (ISDIGIT (*format)) format++; - + /* Skip over the dollar sign. */ format++; } - + switch (*format) { case '%': @@ -804,10 +804,10 @@ gfc_warning (int opt, const char *gmsgid, va_list ap) ++werrorcount; else if (diagnostic.kind == DK_ERROR) ++werrorcount_buffered; - else + else ++werrorcount, --warningcount, ++warningcount_buffered; } - + va_end (argp); return ret; } @@ -902,7 +902,7 @@ gfc_notify_std (int std, const char *gmsgid, ...) if (warning) gfc_warning (0, buffer, argp); else - gfc_error (buffer, argp); + gfc_error_opt (0, buffer, argp); va_end (argp); return (warning && !warnings_are_errors) ? true : false; @@ -916,10 +916,8 @@ gfc_notify_std (int std, const char *gmsgid, ...) %L Takes locus argument */ static bool -gfc_format_decoder (pretty_printer *pp, - text_info *text, const char *spec, - int precision ATTRIBUTE_UNUSED, bool wide ATTRIBUTE_UNUSED, - bool plus ATTRIBUTE_UNUSED, bool hash ATTRIBUTE_UNUSED) +gfc_format_decoder (pretty_printer *pp, text_info *text, const char *spec, + int precision, bool wide, bool set_locus, bool hash) { switch (*spec) { @@ -946,7 +944,11 @@ gfc_format_decoder (pretty_printer *pp, return true; } default: - return false; + /* Fall through info the middle-end decoder, as e.g. stor-layout.c + etc. diagnostics can use the FE printer while the FE is still + active. */ + return default_tree_printer (pp, text, spec, precision, wide, + set_locus, hash); } } @@ -1030,17 +1032,17 @@ gfc_diagnostic_build_locus_prefix (diagnostic_context *context, With -fdiagnostic-show-caret (the default) it prints: [locus of primary range]: - + some code 1 Error: Some error at (1) - + With -fno-diagnostic-show-caret or if the primary range is not valid, it prints: [locus of primary range]: Error: Some error at (1) and (2) */ -static void +static void gfc_diagnostic_starter (diagnostic_context *context, diagnostic_info *diagnostic) { @@ -1051,7 +1053,7 @@ gfc_diagnostic_starter (diagnostic_context *context, bool one_locus = diagnostic->richloc->get_num_locations () < 2; bool same_locus = false; - if (!one_locus) + if (!one_locus) { s2 = diagnostic_expand_location (diagnostic, 1); same_locus = diagnostic_same_line (context, s1, s2); @@ -1089,11 +1091,11 @@ gfc_diagnostic_starter (diagnostic_context *context, } else { - pp_verbatim (context->printer, locus_prefix); + pp_verbatim (context->printer, "%s", locus_prefix); free (locus_prefix); /* Fortran uses an empty line between locus and caret line. */ pp_newline (context->printer); - diagnostic_show_locus (context, diagnostic); + diagnostic_show_locus (context, diagnostic->richloc, diagnostic->kind); /* If the caret line was shown, the prefix does not contain the locus. */ pp_set_prefix (context->printer, kind_prefix); @@ -1106,7 +1108,7 @@ gfc_diagnostic_start_span (diagnostic_context *context, { char *locus_prefix; locus_prefix = gfc_diagnostic_build_locus_prefix (context, exploc); - pp_verbatim (context->printer, locus_prefix); + pp_verbatim (context->printer, "%s", locus_prefix); free (locus_prefix); pp_newline (context->printer); /* Fortran uses an empty line between locus and caret line. */ @@ -1160,6 +1162,24 @@ gfc_warning_now (int opt, const char *gmsgid, ...) return ret; } +/* Internal warning, do not buffer. */ + +bool +gfc_warning_internal (int opt, const char *gmsgid, ...) +{ + va_list argp; + diagnostic_info diagnostic; + rich_location rich_loc (line_table, UNKNOWN_LOCATION); + bool ret; + + va_start (argp, gmsgid); + diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, + DK_WARNING); + diagnostic.option_index = opt; + ret = report_diagnostic (&diagnostic); + va_end (argp); + return ret; +} /* Immediate error (i.e. do not buffer). */ @@ -1223,9 +1243,10 @@ gfc_warning_check (void) werrorcount += werrorcount_buffered; gcc_assert (warningcount_buffered + werrorcount_buffered == 1); pp->buffer = tmp_buffer; - diagnostic_action_after_output (global_dc, - warningcount_buffered + diagnostic_action_after_output (global_dc, + warningcount_buffered ? DK_WARNING : DK_ERROR); + diagnostic_check_max_errors (global_dc, true); } } @@ -1233,7 +1254,7 @@ gfc_warning_check (void) /* Issue an error. */ static void -gfc_error (const char *gmsgid, va_list ap) +gfc_error_opt (int opt, const char *gmsgid, va_list ap) { va_list argp; va_copy (argp, ap); @@ -1241,7 +1262,7 @@ gfc_error (const char *gmsgid, va_list ap) if (warnings_not_errors) { - gfc_warning (/*opt=*/0, gmsgid, argp); + gfc_warning (opt, gmsgid, argp); va_end (argp); return; } @@ -1289,11 +1310,21 @@ gfc_error (const char *gmsgid, va_list ap) void +gfc_error_opt (int opt, const char *gmsgid, ...) +{ + va_list argp; + va_start (argp, gmsgid); + gfc_error_opt (opt, gmsgid, argp); + va_end (argp); +} + + +void gfc_error (const char *gmsgid, ...) { va_list argp; va_start (argp, gmsgid); - gfc_error (gmsgid, argp); + gfc_error_opt (0, gmsgid, argp); va_end (argp); } @@ -1337,7 +1368,7 @@ gfc_clear_error (void) bool gfc_error_flag_test (void) { - return error_buffer.flag + return error_buffer.flag || !gfc_output_buffer_empty_p (pp_error_buffer); } @@ -1360,6 +1391,7 @@ gfc_error_check (void) gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer)); pp->buffer = tmp_buffer; diagnostic_action_after_output (global_dc, DK_ERROR); + diagnostic_check_max_errors (global_dc, true); return true; } diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index d1258cdf38..c8be9513af 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1,5 +1,5 @@ /* Routines for manipulation of expression nodes. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -611,28 +611,44 @@ gfc_replace_expr (gfc_expr *dest, gfc_expr *src) /* Try to extract an integer constant from the passed expression node. - Returns an error message or NULL if the result is set. It is - tempting to generate an error and return true or false, but - failure is OK for some callers. */ + Return true if some error occurred, false on success. If REPORT_ERROR + is non-zero, emit error, for positive REPORT_ERROR using gfc_error, + for negative using gfc_error_now. */ -const char * -gfc_extract_int (gfc_expr *expr, int *result) +bool +gfc_extract_int (gfc_expr *expr, int *result, int report_error) { if (expr->expr_type != EXPR_CONSTANT) - return _("Constant expression required at %C"); + { + if (report_error > 0) + gfc_error ("Constant expression required at %C"); + else if (report_error < 0) + gfc_error_now ("Constant expression required at %C"); + return true; + } if (expr->ts.type != BT_INTEGER) - return _("Integer expression required at %C"); + { + if (report_error > 0) + gfc_error ("Integer expression required at %C"); + else if (report_error < 0) + gfc_error_now ("Integer expression required at %C"); + return true; + } if ((mpz_cmp_si (expr->value.integer, INT_MAX) > 0) || (mpz_cmp_si (expr->value.integer, INT_MIN) < 0)) { - return _("Integer value too large in expression at %C"); + if (report_error > 0) + gfc_error ("Integer value too large in expression at %C"); + else if (report_error < 0) + gfc_error_now ("Integer value too large in expression at %C"); + return true; } *result = (int) mpz_get_si (expr->value.integer); - return NULL; + return false; } @@ -795,8 +811,6 @@ gfc_build_conversion (gfc_expr *e) p = gfc_get_expr (); p->expr_type = EXPR_FUNCTION; p->symtree = NULL; - p->value.function.actual = NULL; - p->value.function.actual = gfc_get_actual_arglist (); p->value.function.actual->expr = e; @@ -883,18 +897,17 @@ done: } -/* Function to determine if an expression is constant or not. This - function expects that the expression has already been simplified. */ +/* Determine if an expression is constant in the sense of F08:7.1.12. + * This function expects that the expression has already been simplified. */ -int +bool gfc_is_constant_expr (gfc_expr *e) { gfc_constructor *c; gfc_actual_arglist *arg; - gfc_symbol *sym; if (e == NULL) - return 1; + return true; switch (e->expr_type) { @@ -904,7 +917,7 @@ gfc_is_constant_expr (gfc_expr *e) || gfc_is_constant_expr (e->value.op.op2))); case EXPR_VARIABLE: - return 0; + return false; case EXPR_FUNCTION: case EXPR_PPC: @@ -917,40 +930,21 @@ gfc_is_constant_expr (gfc_expr *e) { for (arg = e->value.function.actual; arg; arg = arg->next) if (!gfc_is_constant_expr (arg->expr)) - return 0; + return false; } - /* Specification functions are constant. */ - /* F95, 7.1.6.2; F2003, 7.1.7 */ - sym = NULL; - if (e->symtree) - sym = e->symtree->n.sym; - if (e->value.function.esym) - sym = e->value.function.esym; - - if (sym - && sym->attr.function - && sym->attr.pure - && !sym->attr.intrinsic - && !sym->attr.recursive - && sym->attr.proc != PROC_INTERNAL - && sym->attr.proc != PROC_ST_FUNCTION - && sym->attr.proc != PROC_UNKNOWN - && gfc_sym_get_dummy_args (sym) == NULL) - return 1; - if (e->value.function.isym && (e->value.function.isym->elemental || e->value.function.isym->pure || e->value.function.isym->inquiry || e->value.function.isym->transformational)) - return 1; + return true; - return 0; + return false; case EXPR_CONSTANT: case EXPR_NULL: - return 1; + return true; case EXPR_SUBSTRING: return e->ref == NULL || (gfc_is_constant_expr (e->ref->u.ss.start) @@ -964,14 +958,14 @@ gfc_is_constant_expr (gfc_expr *e) for (; c; c = gfc_constructor_next (c)) if (!gfc_is_constant_expr (c->expr)) - return 0; + return false; - return 1; + return true; default: gfc_internal_error ("gfc_is_constant_expr(): Unknown expression type"); - return 0; + return false; } } @@ -2206,7 +2200,7 @@ check_alloc_comp_init (gfc_expr *e) gfc_constructor *ctor; gcc_assert (e->expr_type == EXPR_STRUCTURE); - gcc_assert (e->ts.type == BT_DERIVED); + gcc_assert (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS); for (comp = e->ts.u.derived->components, ctor = gfc_constructor_first (e->value.constructor); @@ -2327,7 +2321,7 @@ check_inquiry (gfc_expr *e, int not_restricted) || ap->expr->symtree->n.sym->ts.deferred)) { gfc_error ("Assumed or deferred character length variable %qs " - " in constant expression at %L", + "in constant expression at %L", ap->expr->symtree->n.sym->name, &ap->expr->where); return MATCH_ERROR; @@ -2741,7 +2735,8 @@ restricted_args (gfc_actual_arglist *a) /************* Restricted/specification expressions *************/ -/* Make sure a non-intrinsic function is a specification function. */ +/* Make sure a non-intrinsic function is a specification function, + * see F08:7.1.11.5. */ static bool external_spec_function (gfc_expr *e) @@ -2794,12 +2789,12 @@ external_spec_function (gfc_expr *e) return false; } - if (f->attr.recursive) - { - gfc_error ("Specification function %qs at %L cannot be RECURSIVE", - f->name, &e->where); + /* F08:7.1.11.6. */ + if (f->attr.recursive + && !gfc_notify_std (GFC_STD_F2003, + "Specification function %qs " + "at %L cannot be RECURSIVE", f->name, &e->where)) return false; - } function_allowed: return restricted_args (e->value.function.actual); @@ -3128,10 +3123,14 @@ gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, . /* Given an assignable expression and an arbitrary expression, make - sure that the assignment can take place. */ + sure that the assignment can take place. Only add a call to the intrinsic + conversion routines, when allow_convert is set. When this assign is a + coarray call, then the convert is done by the coarray routine implictly and + adding the intrinsic conversion would do harm in most cases. */ bool -gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) +gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform, + bool allow_convert) { gfc_symbol *sym; gfc_ref *ref; @@ -3245,7 +3244,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER && lvalue->symtree->n.sym->attr.data && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L used to " - "initialize non-integer variable %qs", + "initialize non-integer variable %qs", &rvalue->where, lvalue->symtree->n.sym->name)) return false; else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data @@ -3309,12 +3308,15 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) kind values can be converted into one another. */ if (lvalue->ts.type == BT_CHARACTER && rvalue->ts.type == BT_CHARACTER) { - if (lvalue->ts.kind != rvalue->ts.kind) - gfc_convert_chartype (rvalue, &lvalue->ts); - - return true; + if (lvalue->ts.kind != rvalue->ts.kind && allow_convert) + return gfc_convert_chartype (rvalue, &lvalue->ts); + else + return true; } + if (!allow_convert) + return true; + return gfc_convert_type (rvalue, &lvalue->ts, 1); } @@ -3371,7 +3373,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) } if (!gfc_notify_std (GFC_STD_F2003, "Bounds specification " - "for %qs in pointer assignment at %L", + "for %qs in pointer assignment at %L", lvalue->symtree->n.sym->name, &lvalue->where)) return false; @@ -3438,7 +3440,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { char err[200]; gfc_symbol *s1,*s2; - gfc_component *comp; + gfc_component *comp1, *comp2; const char *name; attr = gfc_expr_attr (rvalue); @@ -3542,9 +3544,9 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) } } - comp = gfc_get_proc_ptr_comp (lvalue); - if (comp) - s1 = comp->ts.interface; + comp1 = gfc_get_proc_ptr_comp (lvalue); + if (comp1) + s1 = comp1->ts.interface; else { s1 = lvalue->symtree->n.sym; @@ -3552,18 +3554,18 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) s1 = s1->ts.interface; } - comp = gfc_get_proc_ptr_comp (rvalue); - if (comp) + comp2 = gfc_get_proc_ptr_comp (rvalue); + if (comp2) { if (rvalue->expr_type == EXPR_FUNCTION) { - s2 = comp->ts.interface->result; + s2 = comp2->ts.interface->result; name = s2->name; } else { - s2 = comp->ts.interface; - name = comp->name; + s2 = comp2->ts.interface; + name = comp2->name; } } else if (rvalue->expr_type == EXPR_FUNCTION) @@ -3584,25 +3586,50 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) if (s2 && s2->attr.proc_pointer && s2->ts.interface) s2 = s2->ts.interface; - if (s1 == s2 || !s1 || !s2) - return true; + /* Special check for the case of absent interface on the lvalue. + * All other interface checks are done below. */ + if (!s1 && comp1 && comp1->attr.subroutine && s2 && s2->attr.function) + { + gfc_error ("Interface mismatch in procedure pointer assignment " + "at %L: %qs is not a subroutine", &rvalue->where, name); + return false; + } /* F08:7.2.2.4 (4) */ - if (s1->attr.if_source == IFSRC_UNKNOWN - && gfc_explicit_interface_required (s2, err, sizeof(err))) + if (s2 && gfc_explicit_interface_required (s2, err, sizeof(err))) { - gfc_error ("Explicit interface required for %qs at %L: %s", - s1->name, &lvalue->where, err); - return false; + if (comp1 && !s1) + { + gfc_error ("Explicit interface required for component %qs at %L: %s", + comp1->name, &lvalue->where, err); + return false; + } + else if (s1->attr.if_source == IFSRC_UNKNOWN) + { + gfc_error ("Explicit interface required for %qs at %L: %s", + s1->name, &lvalue->where, err); + return false; + } } - if (s2->attr.if_source == IFSRC_UNKNOWN - && gfc_explicit_interface_required (s1, err, sizeof(err))) + if (s1 && gfc_explicit_interface_required (s1, err, sizeof(err))) { - gfc_error ("Explicit interface required for %qs at %L: %s", - s2->name, &rvalue->where, err); - return false; + if (comp2 && !s2) + { + gfc_error ("Explicit interface required for component %qs at %L: %s", + comp2->name, &rvalue->where, err); + return false; + } + else if (s2->attr.if_source == IFSRC_UNKNOWN) + { + gfc_error ("Explicit interface required for %qs at %L: %s", + s2->name, &rvalue->where, err); + return false; + } } + if (s1 == s2 || !s1 || !s2) + return true; + if (!gfc_compare_interfaces (s1, s2, name, 0, 1, err, sizeof(err), NULL, NULL)) { @@ -3713,9 +3740,20 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) if (rvalue->expr_type == EXPR_FUNCTION && !attr.pointer) { - gfc_error ("Target expression in pointer assignment " - "at %L must deliver a pointer result", - &rvalue->where); + /* F2008, C725. For PURE also C1283. Sometimes rvalue is a function call + to caf_get. Map this to the same error message as below when it is + still a variable expression. */ + if (rvalue->value.function.isym + && rvalue->value.function.isym->id == GFC_ISYM_CAF_GET) + /* The test above might need to be extend when F08, Note 5.4 has to be + interpreted in the way that target and pointer with the same coindex + are allowed. */ + gfc_error ("Data target at %L shall not have a coindex", + &rvalue->where); + else + gfc_error ("Target expression in pointer assignment " + "at %L must deliver a pointer result", + &rvalue->where); return false; } @@ -3918,6 +3956,237 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) } +/* 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=. */ + +gfc_expr * +gfc_build_default_init_expr (gfc_typespec *ts, locus *where) +{ + int char_len; + gfc_expr *init_expr; + int i; + + /* Try to build an initializer expression. */ + init_expr = gfc_get_constant_expr (ts->type, ts->kind, where); + + /* We will only initialize integers, reals, complex, logicals, and + characters, and only if the corresponding command-line flags + were set. Otherwise, we free init_expr and return null. */ + switch (ts->type) + { + case BT_INTEGER: + if (gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF) + mpz_set_si (init_expr->value.integer, + gfc_option.flag_init_integer_value); + else + { + gfc_free_expr (init_expr); + init_expr = NULL; + } + break; + + case BT_REAL: + switch (flag_init_real) + { + case GFC_INIT_REAL_SNAN: + init_expr->is_snan = 1; + /* Fall through. */ + case GFC_INIT_REAL_NAN: + mpfr_set_nan (init_expr->value.real); + break; + + case GFC_INIT_REAL_INF: + mpfr_set_inf (init_expr->value.real, 1); + break; + + case GFC_INIT_REAL_NEG_INF: + mpfr_set_inf (init_expr->value.real, -1); + break; + + case GFC_INIT_REAL_ZERO: + mpfr_set_ui (init_expr->value.real, 0.0, GFC_RND_MODE); + break; + + default: + gfc_free_expr (init_expr); + init_expr = NULL; + break; + } + break; + + case BT_COMPLEX: + switch (flag_init_real) + { + case GFC_INIT_REAL_SNAN: + init_expr->is_snan = 1; + /* Fall through. */ + case GFC_INIT_REAL_NAN: + mpfr_set_nan (mpc_realref (init_expr->value.complex)); + mpfr_set_nan (mpc_imagref (init_expr->value.complex)); + break; + + case GFC_INIT_REAL_INF: + mpfr_set_inf (mpc_realref (init_expr->value.complex), 1); + mpfr_set_inf (mpc_imagref (init_expr->value.complex), 1); + break; + + case GFC_INIT_REAL_NEG_INF: + mpfr_set_inf (mpc_realref (init_expr->value.complex), -1); + mpfr_set_inf (mpc_imagref (init_expr->value.complex), -1); + break; + + case GFC_INIT_REAL_ZERO: + mpc_set_ui (init_expr->value.complex, 0, GFC_MPC_RND_MODE); + break; + + default: + gfc_free_expr (init_expr); + init_expr = NULL; + break; + } + break; + + case BT_LOGICAL: + if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_FALSE) + init_expr->value.logical = 0; + else if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_TRUE) + init_expr->value.logical = 1; + else + { + gfc_free_expr (init_expr); + init_expr = NULL; + } + break; + + case BT_CHARACTER: + /* For characters, the length must be constant in order to + create a default initializer. */ + if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON + && ts->u.cl->length + && ts->u.cl->length->expr_type == EXPR_CONSTANT) + { + char_len = mpz_get_si (ts->u.cl->length->value.integer); + init_expr->value.character.length = char_len; + init_expr->value.character.string = gfc_get_wide_string (char_len+1); + for (i = 0; i < char_len; i++) + init_expr->value.character.string[i] + = (unsigned char) gfc_option.flag_init_character_value; + } + else + { + gfc_free_expr (init_expr); + init_expr = NULL; + } + if (!init_expr && gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON + && ts->u.cl->length && flag_max_stack_var_size != 0) + { + gfc_actual_arglist *arg; + init_expr = gfc_get_expr (); + init_expr->where = *where; + init_expr->ts = *ts; + init_expr->expr_type = EXPR_FUNCTION; + init_expr->value.function.isym = + gfc_intrinsic_function_by_id (GFC_ISYM_REPEAT); + init_expr->value.function.name = "repeat"; + arg = gfc_get_actual_arglist (); + arg->expr = gfc_get_character_expr (ts->kind, where, NULL, 1); + arg->expr->value.character.string[0] = + gfc_option.flag_init_character_value; + arg->next = gfc_get_actual_arglist (); + arg->next->expr = gfc_copy_expr (ts->u.cl->length); + init_expr->value.function.actual = arg; + } + break; + + default: + gfc_free_expr (init_expr); + init_expr = NULL; + } + + return init_expr; +} + +/* 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 + combined with some effort. */ + +void +gfc_apply_init (gfc_typespec *ts, symbol_attribute *attr, gfc_expr *init) +{ + if (ts->type == BT_CHARACTER && !attr->pointer && init + && ts->u.cl + && ts->u.cl->length && ts->u.cl->length->expr_type == EXPR_CONSTANT) + { + int len; + + gcc_assert (ts->u.cl && ts->u.cl->length); + gcc_assert (ts->u.cl->length->expr_type == EXPR_CONSTANT); + gcc_assert (ts->u.cl->length->ts.type == BT_INTEGER); + + len = mpz_get_si (ts->u.cl->length->value.integer); + + if (init->expr_type == EXPR_CONSTANT) + gfc_set_constant_character_len (len, init, -1); + else if (init + && init->ts.u.cl + && mpz_cmp (ts->u.cl->length->value.integer, + init->ts.u.cl->length->value.integer)) + { + gfc_constructor *ctor; + ctor = gfc_constructor_first (init->value.constructor); + + if (ctor) + { + int first_len; + bool has_ts = (init->ts.u.cl + && init->ts.u.cl->length_from_typespec); + + /* Remember the length of the first element for checking + that all elements *in the constructor* have the same + length. This need not be the length of the LHS! */ + gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT); + gcc_assert (ctor->expr->ts.type == BT_CHARACTER); + first_len = ctor->expr->value.character.length; + + for ( ; ctor; ctor = gfc_constructor_next (ctor)) + if (ctor->expr->expr_type == EXPR_CONSTANT) + { + gfc_set_constant_character_len (len, ctor->expr, + has_ts ? -1 : first_len); + if (!ctor->expr->ts.u.cl) + ctor->expr->ts.u.cl + = gfc_new_charlen (gfc_current_ns, ts->u.cl); + else + ctor->expr->ts.u.cl->length + = gfc_copy_expr (ts->u.cl->length); + } + } + } + } +} + + +/* Check whether an expression is a structure constructor and whether it has + other values than NULL. */ + +bool +is_non_empty_structure_constructor (gfc_expr * e) +{ + if (e->expr_type != EXPR_STRUCTURE) + return false; + + gfc_constructor *cons = gfc_constructor_first (e->value.constructor); + while (cons) + { + if (!cons->expr || cons->expr->expr_type != EXPR_NULL) + return true; + cons = gfc_constructor_next (cons); + } + return false; +} + + /* Check for default initializer; sym->value is not enough as it is also set for EXPR_NULL of allocatables. */ @@ -3931,7 +4200,10 @@ gfc_has_default_initializer (gfc_symbol *der) if (gfc_bt_struct (c->ts.type)) { if (!c->attr.pointer && !c->attr.proc_pointer - && gfc_has_default_initializer (c->ts.u.derived)) + && !(c->attr.allocatable && der == c->ts.u.derived) + && ((c->initializer + && is_non_empty_structure_constructor (c->initializer)) + || gfc_has_default_initializer (c->ts.u.derived))) return true; if (c->attr.pointer && c->initializer) return true; @@ -3946,21 +4218,157 @@ gfc_has_default_initializer (gfc_symbol *der) } -/* Get an expression for a default initializer. */ +/* + Generate an initializer expression which initializes the entirety of a union. + A normal structure constructor is insufficient without undue effort, because + components of maps may be oddly aligned/overlapped. (For example if a + character is initialized from one map overtop a real from the other, only one + byte of the real is actually initialized.) Unfortunately we don't know the + size of the union right now, so we can't generate a proper initializer, but + we use a NULL expr as a placeholder and do the right thing later in + gfc_trans_subcomponent_assign. + */ +static gfc_expr * +generate_union_initializer (gfc_component *un) +{ + if (un == NULL || un->ts.type != BT_UNION) + return NULL; + + gfc_expr *placeholder = gfc_get_null_expr (&un->loc); + placeholder->ts = un->ts; + return placeholder; +} + + +/* Get the user-specified initializer for a union, if any. This means the user + has said to initialize component(s) of a map. For simplicity's sake we + only allow the user to initialize the first map. We don't have to worry + about overlapping initializers as they are released early in resolution (see + resolve_fl_struct). */ + +static gfc_expr * +get_union_initializer (gfc_symbol *union_type, gfc_component **map_p) +{ + gfc_component *map; + gfc_expr *init=NULL; + + if (!union_type || union_type->attr.flavor != FL_UNION) + return NULL; + + for (map = union_type->components; map; map = map->next) + { + if (gfc_has_default_initializer (map->ts.u.derived)) + { + init = gfc_default_initializer (&map->ts); + if (map_p) + *map_p = map; + break; + } + } + + if (map_p && !init) + *map_p = NULL; + + return init; +} + +/* Fetch or generate an initializer for the given component. + Only generate an initializer if generate is true. */ + +static gfc_expr * +component_initializer (gfc_typespec *ts, gfc_component *c, bool generate) +{ + gfc_expr *init = NULL; + + /* See if we can find the initializer immediately. */ + if (c->initializer || !generate + || (ts->type == BT_CLASS && !c->attr.allocatable)) + return c->initializer; + + /* Recursively handle derived type components. */ + if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + init = gfc_generate_initializer (&c->ts, true); + + else if (c->ts.type == BT_UNION && c->ts.u.derived->components) + { + gfc_component *map = NULL; + gfc_constructor *ctor; + gfc_expr *user_init; + + /* If we don't have a user initializer and we aren't generating one, this + union has no initializer. */ + user_init = get_union_initializer (c->ts.u.derived, &map); + if (!user_init && !generate) + return NULL; + + /* Otherwise use a structure constructor. */ + init = gfc_get_structure_constructor_expr (c->ts.type, c->ts.kind, + &c->loc); + init->ts = c->ts; + + /* If we are to generate an initializer for the union, add a constructor + which initializes the whole union first. */ + if (generate) + { + ctor = gfc_constructor_get (); + ctor->expr = generate_union_initializer (c); + gfc_constructor_append (&init->value.constructor, ctor); + } + + /* If we found an initializer in one of our maps, apply it. Note this + is applied _after_ the entire-union initializer above if any. */ + if (user_init) + { + ctor = gfc_constructor_get (); + ctor->expr = user_init; + ctor->n.component = map; + gfc_constructor_append (&init->value.constructor, ctor); + } + } + + /* Treat simple components like locals. */ + else + { + init = gfc_build_default_init_expr (&c->ts, &c->loc); + gfc_apply_init (&c->ts, &c->attr, init); + } + + return init; +} + + +/* Get an expression for a default initializer of a derived type. */ gfc_expr * gfc_default_initializer (gfc_typespec *ts) { - gfc_expr *init; + return gfc_generate_initializer (ts, false); +} + + +/* Get or generate an expression for a default initializer of a derived type. + If -finit-derived is specified, generate default initialization expressions + for components that lack them when generate is set. */ + +gfc_expr * +gfc_generate_initializer (gfc_typespec *ts, bool generate) +{ + gfc_expr *init, *tmp; gfc_component *comp; + generate = flag_init_derived && generate; /* See if we have a default initializer in this, but not in nested - types (otherwise we could use gfc_has_default_initializer()). */ - for (comp = ts->u.derived->components; comp; comp = comp->next) - if (comp->initializer || comp->attr.allocatable - || (comp->ts.type == BT_CLASS && CLASS_DATA (comp) - && CLASS_DATA (comp)->attr.allocatable)) - break; + types (otherwise we could use gfc_has_default_initializer()). + We don't need to check if we are going to generate them. */ + comp = ts->u.derived->components; + if (!generate) + { + for (; comp; comp = comp->next) + if (comp->initializer || comp->attr.allocatable + || (comp->ts.type == BT_CLASS && CLASS_DATA (comp) + && CLASS_DATA (comp)->attr.allocatable)) + break; + } if (!comp) return NULL; @@ -3973,15 +4381,19 @@ gfc_default_initializer (gfc_typespec *ts) { gfc_constructor *ctor = gfc_constructor_get(); - if (comp->initializer) + /* Fetch or generate an initializer for the component. */ + tmp = component_initializer (ts, comp, generate); + if (tmp) { /* Save the component ref for STRUCTUREs and UNIONs. */ if (ts->u.derived->attr.flavor == FL_STRUCT || ts->u.derived->attr.flavor == FL_UNION) ctor->n.component = comp; - ctor->expr = gfc_copy_expr (comp->initializer); - if ((comp->ts.type != comp->initializer->ts.type - || comp->ts.kind != comp->initializer->ts.kind) + + /* If the initializer was not generated, we need a copy. */ + ctor->expr = comp->initializer ? gfc_copy_expr (tmp) : tmp; + if ((comp->ts.type != tmp->ts.type + || comp->ts.kind != tmp->ts.kind) && !comp->attr.pointer && !comp->attr.proc_pointer) gfc_convert_type_warn (ctor->expr, &comp->ts, 2, false); } @@ -3991,6 +4403,7 @@ gfc_default_initializer (gfc_typespec *ts) { ctor->expr = gfc_get_expr (); ctor->expr->expr_type = EXPR_NULL; + ctor->expr->where = init->where; ctor->expr->ts = comp->ts; } @@ -4428,6 +4841,23 @@ gfc_ref_this_image (gfc_ref *ref) return true; } +gfc_expr * +gfc_find_stat_co(gfc_expr *e) +{ + gfc_ref *ref; + + for (ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0) + return ref->u.ar.stat; + + if (e->value.function.actual->expr) + for (ref = e->value.function.actual->expr->ref; ref; + ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0) + return ref->u.ar.stat; + + return NULL; +} bool gfc_is_coindexed (gfc_expr *e) @@ -4883,7 +5313,8 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, component. Note that (normal) assignment to procedure pointers is not possible. */ check_intentin = !own_scope; - ptr_component = (sym->ts.type == BT_CLASS && CLASS_DATA (sym)) + ptr_component = (sym->ts.type == BT_CLASS && sym->ts.u.derived + && CLASS_DATA (sym)) ? CLASS_DATA (sym)->attr.class_pointer : sym->attr.pointer; for (ref = e->ref; ref && check_intentin; ref = ref->next) { @@ -5039,13 +5470,13 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, { gfc_constructor *c, *n; gfc_expr *ec, *en; - + for (c = gfc_constructor_first (arr->value.constructor); c != NULL; c = gfc_constructor_next (c)) { if (c == NULL || c->iterator != NULL) continue; - + ec = c->expr; for (n = gfc_constructor_next (c); n != NULL; @@ -5053,7 +5484,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, { if (n->iterator != NULL) continue; - + en = n->expr; if (gfc_dep_compare_expr (ec, en) == 0) { @@ -5070,6 +5501,6 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, } } } - + return true; } diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index ea9c0ef2d7..44bd8dcc2a 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -1,5 +1,5 @@ /* gfortran backend interface - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Paul Brook. This file is part of GCC. @@ -30,6 +30,7 @@ along with GCC; see the file COPYING3. If not see #include "tree.h" #include "gfortran.h" #include "trans.h" +#include "stringpool.h" #include "diagnostic.h" /* For errorcount/warningcount */ #include "langhooks.h" #include "langhooks-def.h" @@ -74,7 +75,6 @@ static bool global_bindings_p (void); static bool gfc_init (void); static void gfc_finish (void); static void gfc_be_parse_file (void); -static alias_set_type gfc_get_alias_set (tree); static void gfc_init_ts (void); static tree gfc_builtin_function (tree); @@ -93,6 +93,8 @@ static const struct attribute_spec gfc_attribute_table[] = affects_type_identity } */ { "omp declare target", 0, 0, true, false, false, gfc_handle_omp_declare_target_attribute, false }, + { "omp declare target link", 0, 0, true, false, false, + gfc_handle_omp_declare_target_attribute, false }, { "oacc function", 0, -1, true, false, false, gfc_handle_omp_declare_target_attribute, false }, { NULL, 0, 0, false, false, false, NULL, false } @@ -110,7 +112,6 @@ static const struct attribute_spec gfc_attribute_table[] = #undef LANG_HOOKS_MARK_ADDRESSABLE #undef LANG_HOOKS_TYPE_FOR_MODE #undef LANG_HOOKS_TYPE_FOR_SIZE -#undef LANG_HOOKS_GET_ALIAS_SET #undef LANG_HOOKS_INIT_TS #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING @@ -121,6 +122,7 @@ static const struct attribute_spec gfc_attribute_table[] = #undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR #undef LANG_HOOKS_OMP_CLAUSE_DTOR #undef LANG_HOOKS_OMP_FINISH_CLAUSE +#undef LANG_HOOKS_OMP_SCALAR_P #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF @@ -142,7 +144,6 @@ static const struct attribute_spec gfc_attribute_table[] = #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size -#define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set #define LANG_HOOKS_INIT_TS gfc_init_ts #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing @@ -153,6 +154,7 @@ static const struct attribute_spec gfc_attribute_table[] = #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor #define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause +#define LANG_HOOKS_OMP_SCALAR_P gfc_omp_scalar_p #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref @@ -189,7 +191,8 @@ gfc_create_decls (void) gfc_init_constants (); /* Build our translation-unit decl. */ - current_translation_unit = build_translation_unit_decl (NULL_TREE); + current_translation_unit + = build_translation_unit_decl (get_identifier (main_input_filename)); debug_hooks->register_main_translation_unit (current_translation_unit); } @@ -511,24 +514,6 @@ gfc_init_decl_processing (void) } -/* Return the typed-based alias set for T, which may be an expression - or a type. Return -1 if we don't do anything special. */ - -static alias_set_type -gfc_get_alias_set (tree t) -{ - tree u; - - /* Permit type-punning when accessing an EQUIVALENCEd variable or - mixed type entry master's return value. */ - for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0)) - if (TREE_CODE (u) == COMPONENT_REF - && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE) - return 0; - - return -1; -} - /* Builtin function initialization. */ static tree @@ -1241,6 +1226,17 @@ gfc_init_builtin_functions (void) #undef DEF_GOMP_BUILTIN } +#ifdef ENABLE_HSA + if (!flag_disable_hsa) + { +#undef DEF_HSA_BUILTIN +#define DEF_HSA_BUILTIN(code, name, type, attr) \ + gfc_define_builtin ("__builtin_" name, builtin_types[type], \ + code, name, attr); +#include "../hsa-builtins.def" + } +#endif + gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID], BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST); TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 1655de2c9f..459967d5c3 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -1,5 +1,5 @@ /* Pass manager for Fortran front end. - Copyright (C) 2010-2016 Free Software Foundation, Inc. + Copyright (C) 2010-2017 Free Software Foundation, Inc. Contributed by Thomas König. This file is part of GCC. @@ -45,9 +45,13 @@ static void realloc_strings (gfc_namespace *); static gfc_expr *create_var (gfc_expr *, const char *vname=NULL); static int inline_matmul_assign (gfc_code **, int *, void *); static gfc_code * create_do_loop (gfc_expr *, gfc_expr *, gfc_expr *, - locus *, gfc_namespace *, + locus *, gfc_namespace *, char *vname=NULL); +#ifdef CHECKING_P +static void check_locus (gfc_namespace *); +#endif + /* How deep we are inside an argument list. */ static int count_arglist; @@ -108,7 +112,7 @@ static int var_num = 1; enum matrix_case { none=0, A2B2, A2B1, A1B2, A2B2T }; -/* Keep track of the number of expressions we have inserted so far +/* Keep track of the number of expressions we have inserted so far using create_var. */ int n_vars; @@ -127,6 +131,10 @@ gfc_run_passes (gfc_namespace *ns) doloop_list.release (); int w, e; +#ifdef CHECKING_P + check_locus (ns); +#endif + if (flag_frontend_optimize) { optimize_namespace (ns); @@ -145,9 +153,56 @@ gfc_run_passes (gfc_namespace *ns) realloc_strings (ns); } +#ifdef CHECKING_P + +/* Callback function: Warn if there is no location information in a + statement. */ + +static int +check_locus_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + current_code = c; + if (c && *c && (((*c)->loc.nextc == NULL) || ((*c)->loc.lb == NULL))) + gfc_warning_internal (0, "No location in statement"); + + return 0; +} + + +/* Callback function: Warn if there is no location information in an + expression. */ + +static int +check_locus_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + + if (e && *e && (((*e)->where.nextc == NULL || (*e)->where.lb == NULL))) + gfc_warning_internal (0, "No location in expression near %L", + &((*current_code)->loc)); + return 0; +} + +/* Run check for missing location information. */ + +static void +check_locus (gfc_namespace *ns) +{ + gfc_code_walker (&ns->code, check_locus_code, check_locus_expr, NULL); + + for (ns = ns->contained; ns; ns = ns->sibling) + { + if (ns->code == NULL || ns->code->op != EXEC_BLOCK) + check_locus (ns); + } +} + +#endif + /* Callback for each gfc_code node invoked from check_realloc_strings. For an allocatable LHS string which also appears as a variable on - the RHS, replace + the RHS, replace a = a(x:y) @@ -164,19 +219,34 @@ realloc_string_callback (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, gfc_expr *expr1, *expr2; gfc_code *co = *c; gfc_expr *n; + gfc_ref *ref; + bool found_substr; if (co->op != EXEC_ASSIGN) return 0; expr1 = co->expr1; if (expr1->ts.type != BT_CHARACTER || expr1->rank != 0 - || !expr1->symtree->n.sym->attr.allocatable) + || !gfc_expr_attr(expr1).allocatable + || !expr1->ts.deferred) return 0; expr2 = gfc_discard_nops (co->expr2); if (expr2->expr_type != EXPR_VARIABLE) return 0; + found_substr = false; + for (ref = expr2->ref; ref; ref = ref->next) + { + if (ref->type == REF_SUBSTRING) + { + found_substr = true; + break; + } + } + if (!found_substr) + return 0; + if (!gfc_check_dependency (expr1, expr2, true)) return 0; @@ -190,7 +260,7 @@ realloc_string_callback (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, current_code = c; inserted_block = NULL; changed_statement = NULL; - n = create_var (expr2, "trim"); + n = create_var (expr2, "realloc_string"); co->expr2 = n; return 0; } @@ -434,7 +504,7 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, return 0; /* We don't do character functions with unknown charlens. */ - if ((*e)->ts.type == BT_CHARACTER + if ((*e)->ts.type == BT_CHARACTER && ((*e)->ts.u.cl == NULL || (*e)->ts.u.cl->length == NULL || (*e)->ts.u.cl->length->expr_type != EXPR_CONSTANT)) return 0; @@ -458,7 +528,7 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, if ((*e)->rank > 0 && (*e)->shape == NULL && !flag_realloc_lhs) return 0; - + /* Skip the test for pure functions if -faggressive-function-elimination is specified. */ if ((*e)->value.function.esym) @@ -540,7 +610,7 @@ constant_string_length (gfc_expr *e) { res = gfc_get_constant_expr (BT_INTEGER, gfc_charlen_int_kind, &e->where); - + mpz_add_ui (res->value.integer, value, 1); mpz_clear (value); return res; @@ -580,7 +650,7 @@ insert_block () /* If the statement has a label, make sure it is transferred to the newly created block. */ - if ((*current_code)->here) + if ((*current_code)->here) { inserted_block->here = (*current_code)->here; (*current_code)->here = NULL; @@ -653,12 +723,12 @@ create_var (gfc_expr * e, const char *vname) for (i=0; i<e->rank; i++) { gfc_expr *p, *q; - + p = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind, &(e->where)); mpz_set_si (p->value.integer, 1); symbol->as->lower[i] = p; - + q = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind, &(e->where)); mpz_set (q->value.integer, e->shape[i]); @@ -732,10 +802,12 @@ do_warn_function_elimination (gfc_expr *e) if (e->expr_type != EXPR_FUNCTION) return; if (e->value.function.esym) - gfc_warning (0, "Removing call to function %qs at %L", + gfc_warning (OPT_Wfunction_elimination, + "Removing call to function %qs at %L", e->value.function.esym->name, &(e->where)); else if (e->value.function.isym) - gfc_warning (0, "Removing call to function %qs at %L", + gfc_warning (OPT_Wfunction_elimination, + "Removing call to function %qs at %L", e->value.function.isym->name, &(e->where)); } /* Callback function for the code walker for doing common function @@ -828,7 +900,7 @@ cfe_code (gfc_code **c, int *walk_subtrees, void *data ATTRIBUTE_UNUSED) *walk_subtrees = 0; return 0; } - + return 0; } @@ -1061,6 +1133,9 @@ optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op) { gfc_expr *e; + if (!*rhs) + return false; + e = *rhs; if (e->expr_type == EXPR_OP) { @@ -1093,8 +1168,8 @@ optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op) } } else if (seen_op && e->expr_type == EXPR_FUNCTION && e->rank > 0 - && ! (e->value.function.esym - && (e->value.function.esym->attr.elemental + && ! (e->value.function.esym + && (e->value.function.esym->attr.elemental || e->value.function.esym->attr.allocatable || e->value.function.esym->ts.type != c->expr1->ts.type || e->value.function.esym->ts.kind != c->expr1->ts.kind)) @@ -1120,7 +1195,7 @@ optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op) new_expr = gfc_copy_expr (c->expr1); c->expr2 = e; *rhs = new_expr; - + return true; } @@ -1137,6 +1212,8 @@ remove_trim (gfc_expr *rhs) bool ret; ret = false; + if (!rhs) + return ret; /* Check for a // b // trim(c). Looping is probably not necessary because the parser usually generates @@ -1274,6 +1351,9 @@ combine_array_constructor (gfc_expr *e) op1 = e->value.op.op1; op2 = e->value.op.op2; + if (!op1 || !op2) + return false; + if (op1->expr_type == EXPR_ARRAY && op2->rank == 0) scalar_first = false; else if (op2->expr_type == EXPR_ARRAY && op1->rank == 0) @@ -1301,7 +1381,7 @@ combine_array_constructor (gfc_expr *e) new_expr->ts = e->ts; new_expr->expr_type = EXPR_OP; new_expr->rank = c->expr->rank; - new_expr->where = c->where; + new_expr->where = c->expr->where; new_expr->value.op.op = e->value.op.op; if (scalar_first) @@ -1358,7 +1438,7 @@ optimize_power (gfc_expr *e) "_internal_iand", e->where, 2, op2, gfc_get_int_expr (e->ts.kind, &e->where, 1)); - + ishft = gfc_build_intrinsic_call (current_ns, GFC_ISYM_ISHFT, "_internal_ishft", e->where, 2, iand, gfc_get_int_expr (e->ts.kind, @@ -1458,7 +1538,7 @@ optimize_op (gfc_expr *e) case INTRINSIC_LT: changed = optimize_comparison (e, op); - /* Fall through */ + gcc_fallthrough (); /* Look at array constructors. */ case INTRINSIC_PLUS: case INTRINSIC_MINUS: @@ -1468,7 +1548,6 @@ optimize_op (gfc_expr *e) case INTRINSIC_POWER: return optimize_power (e); - break; default: break; @@ -1693,7 +1772,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op) case INTRINSIC_EQ: result = eq == 0; break; - + case INTRINSIC_GE: result = eq >= 0; break; @@ -1713,7 +1792,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op) case INTRINSIC_LT: result = eq < 0; break; - + default: gfc_internal_error ("illegal OP in optimize_comparison"); break; @@ -1832,7 +1911,7 @@ optimize_minmaxloc (gfc_expr **e) strcpy (name, fn->value.function.name); p = strstr (name, "loc0"); p[3] = '1'; - fn->value.function.name = gfc_get_string (name); + fn->value.function.name = gfc_get_string ("%s", name); if (fn->value.function.actual->next) { a = fn->value.function.actual->next; @@ -1897,12 +1976,12 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, FOR_EACH_VEC_ELT (doloop_list, i, cl) { gfc_symbol *do_sym; - + if (cl == NULL) break; do_sym = cl->ext.iterator->var->symtree->n.sym; - + if (a->expr && a->expr->symtree && a->expr->symtree->n.sym == do_sym) { @@ -1974,7 +2053,7 @@ do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, break; do_sym = dl->ext.iterator->var->symtree->n.sym; - + if (a->expr && a->expr->symtree && a->expr->symtree->n.sym == do_sym) { @@ -2205,7 +2284,7 @@ runtime_error_ne (gfc_expr *e1, gfc_expr *e2, const char *msg) /* Handle matrix reallocation. Caller is responsible to insert into the code tree. - For the two-dimensional case, build + For the two-dimensional case, build if (allocated(c)) then if (size(c,1) /= size(a,1) .or. size(c,2) /= size(b,2)) then @@ -2298,7 +2377,7 @@ matmul_lhs_realloc (gfc_expr *c, gfc_expr *a, gfc_expr *b, /* We need two identical allocate statements in two branches of the IF statement. */ - + allocate1 = XCNEW (gfc_code); allocate1->op = EXEC_ALLOCATE; allocate1->ext.alloc.list = gfc_get_alloc (); @@ -2321,7 +2400,7 @@ matmul_lhs_realloc (gfc_expr *c, gfc_expr *a, gfc_expr *b, deallocate->ext.alloc.list->expr = gfc_copy_expr (c); deallocate->next = allocate1; deallocate->loc = c->where; - + if_size_2 = XCNEW (gfc_code); if_size_2->op = EXEC_IF; if_size_2->expr1 = cond; @@ -2601,7 +2680,7 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index, int count_index) /* Loop over the indices. For each index, create the expression index * stride + lbound(e, dim). */ - + i_index = 0; for (i=0; i < ar->dimen; i++) { @@ -2611,9 +2690,9 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index, int count_index) { gfc_expr *lbound, *nindex; gfc_expr *loopvar; - - loopvar = gfc_copy_expr (index[i_index]); - + + loopvar = gfc_copy_expr (index[i_index]); + if (ar->stride[i]) { gfc_expr *tmp; @@ -2631,7 +2710,7 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index, int count_index) } else nindex = loopvar; - + /* Calculate the lower bound of the expression. */ if (ar->start[i]) { @@ -2698,12 +2777,12 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index, int count_index) i + 1); gfc_free_expr (lbound_e); } - + ar->dimen_type[i] = DIMEN_ELEMENT; gfc_free_expr (ar->start[i]); ar->start[i] = get_operand (INTRINSIC_PLUS, nindex, lbound); - + gfc_free_expr (ar->end[i]); ar->end[i] = NULL; gfc_free_expr (ar->stride[i]); @@ -2802,7 +2881,7 @@ check_conjg_transpose_variable (gfc_expr *e, bool *conjg, bool *transpose) end do end do END BLOCK - + */ static int @@ -2835,6 +2914,11 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees, if (in_where) return 0; + /* The BLOCKS generated for the temporary variables and FORALL don't + mix. */ + if (forall_level > 0) + return 0; + /* For now don't do anything in OpenMP workshare, it confuses its translation, which expects only the allowed statements in there. We should figure out how to parallelize this eventually. */ @@ -3234,7 +3318,7 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees, matrix_a->where, 1, ascalar); if (conjg_b) - bscalar = gfc_build_intrinsic_call (ns, GFC_ISYM_CONJG, "conjg", + bscalar = gfc_build_intrinsic_call (ns, GFC_ISYM_CONJG, "conjg", matrix_b->where, 1, bscalar); /* First loop comes after the zero assignment. */ @@ -3326,6 +3410,7 @@ gfc_expr_walker (gfc_expr **e, walk_expr_fn_t exprfn, void *data) /* Fall through to the variable case in order to walk the reference. */ + gcc_fallthrough (); case EXPR_SUBSTRING: case EXPR_VARIABLE: @@ -3512,6 +3597,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.open->asynchronous); WALK_SUBEXPR (co->ext.open->id); WALK_SUBEXPR (co->ext.open->newunit); + WALK_SUBEXPR (co->ext.open->share); + WALK_SUBEXPR (co->ext.open->cc); break; case EXEC_CLOSE: @@ -3607,7 +3694,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, /* This goto serves as a shortcut to avoid code duplication or a larger if or switch statement. */ goto check_omp_clauses; - + case EXEC_OMP_WORKSHARE: case EXEC_OMP_PARALLEL_WORKSHARE: @@ -3615,18 +3702,28 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, /* Fall through */ + case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_ORDERED: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_END_SINGLE: case EXEC_OMP_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -3662,6 +3759,12 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.omp_clauses->device); WALK_SUBEXPR (co->ext.omp_clauses->thread_limit); WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size); + WALK_SUBEXPR (co->ext.omp_clauses->grainsize); + WALK_SUBEXPR (co->ext.omp_clauses->hint); + WALK_SUBEXPR (co->ext.omp_clauses->num_tasks); + WALK_SUBEXPR (co->ext.omp_clauses->priority); + for (idx = 0; idx < OMP_IF_LAST; idx++) + WALK_SUBEXPR (co->ext.omp_clauses->if_exprs[idx]); for (idx = 0; idx < sizeof (list_types) / sizeof (list_types[0]); idx++) diff --git a/gcc/fortran/gfc-diagnostic.def b/gcc/fortran/gfc-diagnostic.def index 8f6100e60f..9483407164 100644 --- a/gcc/fortran/gfc-diagnostic.def +++ b/gcc/fortran/gfc-diagnostic.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2001-2016 Free Software Foundation, Inc. +/* Copyright (C) 2001-2017 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 0829bc3823..cef61a7678 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-2016 +@set copyrights-gfortran 2007-2017 @include gcc-common.texi @@ -761,11 +761,11 @@ Some relevant references: GNU @command{ld} manual} @item -@uref{http://www.akkadia.org/drepper/symbol-versioning, ELF Symbol +@uref{https://www.akkadia.org/drepper/symbol-versioning, ELF Symbol Versioning - Ulrich Depper} @item -@uref{http://www.akkadia.org/drepper/dsohowto.pdf, How to Write Shared +@uref{https://www.akkadia.org/drepper/dsohowto.pdf, How to Write Shared Libraries - Ulrich Drepper (see Chapter 3)} @end itemize diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 0bb71cb184..293655078a 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1,5 +1,5 @@ /* gfortran header file - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -60,7 +60,7 @@ not after. #define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */ -#define gfc_is_whitespace(c) ((c==' ') || (c=='\t')) +#define gfc_is_whitespace(c) ((c==' ') || (c=='\t') || (c=='\f')) /* Macros to check for groups of structure-like types and flavors since derived types, structures, maps, unions are often treated similarly. */ @@ -177,8 +177,11 @@ enum gfc_intrinsic_op /* .EQ., .NE., .GT., .GE., .LT., .LE. (OS = Old-Style) */ INTRINSIC_EQ_OS, INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS, INTRINSIC_LT_OS, INTRINSIC_LE_OS, - INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN, - INTRINSIC_PARENTHESES, GFC_INTRINSIC_END /* Sentinel */ + INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN, INTRINSIC_PARENTHESES, + GFC_INTRINSIC_END, /* Sentinel */ + /* User defined derived type pseudo operators. These are set beyond the + sentinel so that they are excluded from module_read and module_write. */ + INTRINSIC_FORMATTED, INTRINSIC_UNFORMATTED }; /* This macro is the number of intrinsic operators that exist. @@ -251,9 +254,16 @@ enum gfc_statement ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_TARGET_PARALLEL, ST_OMP_END_TARGET_PARALLEL, + ST_OMP_TARGET_PARALLEL_DO, ST_OMP_END_TARGET_PARALLEL_DO, + ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD, + ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA, + ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, + ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, + ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, - ST_EVENT_WAIT,ST_NONE + ST_EVENT_WAIT,ST_FAIL_IMAGE,ST_NONE }; /* Types of interfaces that we can have. Assignment interfaces are @@ -261,7 +271,8 @@ enum gfc_statement enum interface_type { INTERFACE_NAMELESS = 1, INTERFACE_GENERIC, - INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT + INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT, + INTERFACE_DTIO }; /* Symbol flavors: these are all mutually exclusive. @@ -313,6 +324,12 @@ extern const mstring access_types[]; extern const mstring ifsrc_types[]; extern const mstring save_status[]; +/* Strings for DTIO procedure names. In symbol.c. */ +extern const mstring dtio_procs[]; + +enum dtio_codes +{ DTIO_RF = 0, DTIO_WF, DTIO_RUF, DTIO_WUF }; + /* Enumeration of all the generic intrinsic functions. Used by the backend for identification of a function. */ @@ -380,6 +397,7 @@ enum gfc_isym_id GFC_ISYM_CONVERSION, GFC_ISYM_COS, GFC_ISYM_COSH, + GFC_ISYM_COTAN, GFC_ISYM_COUNT, GFC_ISYM_CPU_TIME, GFC_ISYM_CSHIFT, @@ -411,6 +429,7 @@ enum gfc_isym_id GFC_ISYM_EXP, GFC_ISYM_EXPONENT, GFC_ISYM_EXTENDS_TYPE_OF, + GFC_ISYM_FAILED_IMAGES, GFC_ISYM_FDATE, GFC_ISYM_FE_RUNTIME_ERROR, GFC_ISYM_FGET, @@ -454,6 +473,7 @@ enum gfc_isym_id GFC_ISYM_IEOR, GFC_ISYM_IERRNO, GFC_ISYM_IMAGE_INDEX, + GFC_ISYM_IMAGE_STATUS, GFC_ISYM_INDEX, GFC_ISYM_INT, GFC_ISYM_INT2, @@ -567,6 +587,7 @@ enum gfc_isym_id GFC_ISYM_SRAND, GFC_ISYM_SR_KIND, GFC_ISYM_STAT, + GFC_ISYM_STOPPED_IMAGES, GFC_ISYM_STORAGE_SIZE, GFC_ISYM_STRIDE, GFC_ISYM_SUM, @@ -726,7 +747,7 @@ typedef struct optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1, dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1, implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1, - contiguous:1, fe_temp: 1; + contiguous:1, fe_temp: 1, automatic: 1; /* For CLASS containers, the pointer attribute is sometimes set internally even though it was not directly specified. In this case, keep the @@ -784,7 +805,7 @@ typedef struct unsigned implicit_pure:1; /* This is set for a procedure that contains expressions referencing - arrays coming from outside its namespace. + arrays coming from outside its namespace. This is used to force the creation of a temporary when the LHS of an array assignment may be used by an elemental procedure appearing on the RHS. */ @@ -841,7 +862,8 @@ typedef struct entities. */ unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1, private_comp:1, zero_comp:1, coarray_comp:1, lock_comp:1, - event_comp:1, defined_assign_comp:1, unlimited_polymorphic:1; + event_comp:1, defined_assign_comp:1, unlimited_polymorphic:1, + has_dtio_procs:1; /* This is a temporary selector for SELECT TYPE or an associate variable for SELECT_TYPE or ASSOCIATE. */ @@ -853,6 +875,7 @@ typedef struct /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; + unsigned omp_declare_target_link:1; /* Mentioned in OACC DECLARE. */ unsigned oacc_declare_create:1; @@ -1033,6 +1056,8 @@ typedef struct gfc_component /* Needed for procedure pointer components. */ struct gfc_typebound_proc *tb; + /* When allocatable/pointer and in a coarray the associated token. */ + tree caf_token; } gfc_component; @@ -1114,7 +1139,9 @@ enum gfc_omp_depend_op { OMP_DEPEND_IN, OMP_DEPEND_OUT, - OMP_DEPEND_INOUT + OMP_DEPEND_INOUT, + OMP_DEPEND_SINK_FIRST, + OMP_DEPEND_SINK }; enum gfc_omp_map_op @@ -1131,7 +1158,19 @@ enum gfc_omp_map_op OMP_MAP_FORCE_PRESENT, OMP_MAP_FORCE_DEVICEPTR, OMP_MAP_DEVICE_RESIDENT, - OMP_MAP_LINK + OMP_MAP_LINK, + OMP_MAP_RELEASE, + OMP_MAP_ALWAYS_TO, + OMP_MAP_ALWAYS_FROM, + OMP_MAP_ALWAYS_TOFROM +}; + +enum gfc_omp_linear_op +{ + OMP_LINEAR_DEFAULT, + OMP_LINEAR_REF, + OMP_LINEAR_VAL, + OMP_LINEAR_UVAL }; /* For use in OpenMP clauses in case we need extra information @@ -1146,6 +1185,8 @@ typedef struct gfc_omp_namelist gfc_omp_reduction_op reduction_op; gfc_omp_depend_op depend_op; gfc_omp_map_op map_op; + gfc_omp_linear_op linear_op; + struct gfc_common_head *common; } u; struct gfc_omp_namelist_udr *udr; struct gfc_omp_namelist *next; @@ -1176,6 +1217,8 @@ enum OMP_LIST_LINK, OMP_LIST_USE_DEVICE, OMP_LIST_CACHE, + OMP_LIST_IS_DEVICE_PTR, + OMP_LIST_USE_DEVICE_PTR, OMP_LIST_NUM }; @@ -1218,6 +1261,19 @@ enum gfc_omp_cancel_kind OMP_CANCEL_TASKGROUP }; +enum gfc_omp_if_kind +{ + OMP_IF_PARALLEL, + OMP_IF_TASK, + OMP_IF_TASKLOOP, + OMP_IF_TARGET, + OMP_IF_TARGET_DATA, + OMP_IF_TARGET_UPDATE, + OMP_IF_TARGET_ENTER_DATA, + OMP_IF_TARGET_EXIT_DATA, + OMP_IF_LAST +}; + typedef struct gfc_omp_clauses { struct gfc_expr *if_expr; @@ -1227,9 +1283,11 @@ typedef struct gfc_omp_clauses enum gfc_omp_sched_kind sched_kind; struct gfc_expr *chunk_size; enum gfc_omp_default_sharing default_sharing; - int collapse; + int collapse, orderedc; bool nowait, ordered, untied, mergeable; - bool inbranch, notinbranch; + bool inbranch, notinbranch, defaultmap, nogroup; + bool sched_simd, sched_monotonic, sched_nonmonotonic; + bool simd, threads, depend_source; enum gfc_omp_cancel_kind cancel; enum gfc_omp_proc_bind_kind proc_bind; struct gfc_expr *safelen_expr; @@ -1237,8 +1295,14 @@ typedef struct gfc_omp_clauses struct gfc_expr *num_teams; struct gfc_expr *device; struct gfc_expr *thread_limit; + struct gfc_expr *grainsize; + struct gfc_expr *hint; + struct gfc_expr *num_tasks; + struct gfc_expr *priority; + struct gfc_expr *if_exprs[OMP_IF_LAST]; enum gfc_omp_sched_kind dist_sched_kind; struct gfc_expr *dist_chunk_size; + const char *critical_name; /* OpenACC. */ struct gfc_expr *async_expr; @@ -1471,19 +1535,27 @@ typedef struct gfc_symbol gfc_namelist *namelist, *namelist_tail; /* Change management fields. Symbols that might be modified by the - current statement have the mark member nonzero and are kept in a - singly linked list through the tlink field. Of these symbols, + 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. */ - - struct gfc_symbol *old_symbol, *tlink; + the old symbol. gfc_new is used in symbol.c to flag new symbols. */ + struct gfc_symbol *old_symbol; unsigned mark:1, gfc_new:1; + + /* The tlink field is used in the front end to carry the module + declaration of separate module procedures so that the characteristics + can be compared with the corresponding declaration in a submodule. In + translation this field carries a linked list of symbols that require + deferred initialization. */ + struct gfc_symbol *tlink; + /* Nonzero if all equivalences associated with this symbol have been processed. */ unsigned equiv_built:1; /* Set if this variable is used as an index name in a FORALL. */ unsigned forall_index:1; + /* Set if the symbol is used in a function result specification . */ + unsigned fn_result_spec:1; /* Used to avoid multiple resolutions of a single symbol. */ unsigned resolved:1; /* Set if this is a module function or subroutine with the @@ -1527,7 +1599,9 @@ struct gfc_undo_change_set typedef struct gfc_common_head { locus where; - char use_assoc, saved, threadprivate, omp_declare_target; + char use_assoc, saved, threadprivate; + unsigned char omp_declare_target : 1; + unsigned char omp_declare_target_link : 1; char name[GFC_MAX_SYMBOL_LEN + 1]; struct gfc_symbol *head; const char* binding_label; @@ -1705,7 +1779,7 @@ typedef struct gfc_namespace /* !$ACC ROUTINE names. */ gfc_oacc_routine_name *oacc_routine_names; - gfc_charlen *cl_list, *old_cl_list; + gfc_charlen *cl_list; gfc_dt_list *derived_types; @@ -1814,6 +1888,7 @@ typedef struct gfc_array_ref int dimen; /* # of components in the reference */ int codimen; bool in_allocate; /* For coarray checks. */ + gfc_expr *stat; locus where; gfc_array_spec *as; @@ -2269,7 +2344,9 @@ typedef struct { gfc_expr *unit, *file, *status, *access, *form, *recl, *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert, - *decimal, *encoding, *round, *sign, *asynchronous, *id, *newunit; + *decimal, *encoding, *round, *sign, *asynchronous, *id, *newunit, + *share, *cc; + char readonly; gfc_st_label *err; } gfc_open; @@ -2298,7 +2375,7 @@ typedef struct *unformatted, *recl, *nextrec, *blank, *position, *action, *read, *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos, *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id, - *iqstream; + *iqstream, *share, *cc; gfc_st_label *err; @@ -2318,7 +2395,8 @@ typedef struct { gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg, *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round, - *sign, *extra_comma, *dt_io_kind; + *sign, *extra_comma, *dt_io_kind, *udtio; + char default_exp; gfc_symbol *namelist; /* A format_label of `format_asterisk' indicates the "*" format */ @@ -2382,7 +2460,7 @@ enum gfc_exec_op EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT, EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END, EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH, - EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT, + EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT, EXEC_FAIL_IMAGE, EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE, EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE, @@ -2406,7 +2484,11 @@ enum gfc_exec_op EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, - EXEC_OMP_TARGET_UPDATE + EXEC_OMP_TARGET_UPDATE, EXEC_OMP_END_CRITICAL, + EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA, + EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO, + EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD, + EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD }; enum gfc_omp_atomic_op @@ -2534,8 +2616,6 @@ typedef struct int flag_init_character; char flag_init_character_value; - int flag_dec_structure; - int fpe; int fpe_summary; int rtcheck; @@ -2709,12 +2789,14 @@ const char *gfc_print_wide_char (gfc_char_t); bool gfc_warning (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); +bool gfc_warning_internal (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...) ATTRIBUTE_GCC_GFC(3,4); void gfc_clear_warning (void); void gfc_warning_check (void); +void gfc_error_opt (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2); @@ -2757,7 +2839,7 @@ 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); tree gfc_get_union_type (gfc_symbol *); -tree gfc_get_derived_type (gfc_symbol * derived); +tree gfc_get_derived_type (gfc_symbol * derived, int codimen = 0); extern int gfc_index_integer_kind; extern int gfc_default_integer_kind; extern int gfc_max_integer_kind; @@ -2802,9 +2884,12 @@ bool gfc_add_cray_pointee (symbol_attribute *, locus *); match gfc_mod_pointee_as (gfc_array_spec *); bool gfc_add_protected (symbol_attribute *, const char *, locus *); bool gfc_add_result (symbol_attribute *, const char *, locus *); +bool gfc_add_automatic (symbol_attribute *, const char *, locus *); bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *); 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 *); @@ -2998,7 +3083,7 @@ void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *); /* expr.c */ void gfc_free_actual_arglist (gfc_actual_arglist *); gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *); -const char *gfc_extract_int (gfc_expr *, int *); +bool gfc_extract_int (gfc_expr *, int *, int = 0); bool is_subref_array (gfc_expr *); bool gfc_is_simply_contiguous (gfc_expr *, bool, bool); bool gfc_check_init_expr (gfc_expr *); @@ -3006,7 +3091,7 @@ bool gfc_check_init_expr (gfc_expr *); gfc_expr *gfc_build_conversion (gfc_expr *); void gfc_free_ref_list (gfc_ref *); void gfc_type_convert_binary (gfc_expr *, int); -int gfc_is_constant_expr (gfc_expr *); +bool gfc_is_constant_expr (gfc_expr *); bool gfc_simplify_expr (gfc_expr *, int); int gfc_has_vector_index (gfc_expr *); @@ -3036,12 +3121,15 @@ int gfc_numeric_ts (gfc_typespec *); int gfc_kind_max (gfc_expr *, gfc_expr *); bool gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3; -bool gfc_check_assign (gfc_expr *, gfc_expr *, int); +bool gfc_check_assign (gfc_expr *, gfc_expr *, int, bool c = true); bool gfc_check_pointer_assign (gfc_expr *, gfc_expr *); bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *); +gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *); +void gfc_apply_init (gfc_typespec *, symbol_attribute *, gfc_expr *); bool gfc_has_default_initializer (gfc_symbol *); gfc_expr *gfc_default_initializer (gfc_typespec *); +gfc_expr *gfc_generate_initializer (gfc_typespec *, bool); gfc_expr *gfc_get_variable_expr (gfc_symtree *); void gfc_add_full_array_ref (gfc_expr *, gfc_array_spec *); gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *); @@ -3065,7 +3153,7 @@ bool gfc_is_coarray (gfc_expr *); int gfc_get_corank (gfc_expr *); bool gfc_has_ultimate_allocatable (gfc_expr *); bool gfc_has_ultimate_pointer (gfc_expr *); - +gfc_expr* gfc_find_stat_co (gfc_expr *); gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*, locus, unsigned, ...); bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*); @@ -3095,7 +3183,7 @@ bool gfc_resolve_iterator (gfc_iterator *, bool, bool); bool find_forall_index (gfc_expr *, gfc_symbol *, int); bool gfc_resolve_index (gfc_expr *, int); bool gfc_resolve_dim_arg (gfc_expr *); -int gfc_is_formal_arg (void); +bool gfc_is_formal_arg (void); 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 *); @@ -3129,25 +3217,25 @@ bool gfc_check_constructor (gfc_expr *, bool (*)(gfc_expr *)); bool gfc_array_size (gfc_expr *, mpz_t *); bool gfc_array_dimen_size (gfc_expr *, int, mpz_t *); bool gfc_array_ref_shape (gfc_array_ref *, mpz_t *); -gfc_array_ref *gfc_find_array_ref (gfc_expr *); +gfc_array_ref *gfc_find_array_ref (gfc_expr *, bool a = false); tree gfc_conv_array_initializer (tree type, gfc_expr *); bool spec_size (gfc_array_spec *, mpz_t *); bool spec_dimen_size (gfc_array_spec *, int, mpz_t *); -int gfc_is_compile_time_shape (gfc_array_spec *); +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 */ void gfc_free_interface (gfc_interface *); -int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *); -int gfc_compare_types (gfc_typespec *, gfc_typespec *); +bool gfc_compare_derived_types (gfc_symbol *, gfc_symbol *); +bool gfc_compare_types (gfc_typespec *, gfc_typespec *); bool gfc_check_dummy_characteristics (gfc_symbol *, gfc_symbol *, bool, char *, int); bool gfc_check_result_characteristics (gfc_symbol *, gfc_symbol *, char *, int); -int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int, - char *, int, const char *, const char *); +bool gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int, + char *, int, const char *, const char *); void gfc_check_interfaces (gfc_namespace *); bool gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *); @@ -3163,9 +3251,13 @@ void gfc_set_current_interface_head (gfc_interface *); gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*); bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*); bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus); -int gfc_has_vector_subscript (gfc_expr*); +bool gfc_has_vector_subscript (gfc_expr*); gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op); bool gfc_check_typebound_override (gfc_symtree*, gfc_symtree*); +void gfc_check_dtio_interfaces (gfc_symbol*); +gfc_symtree* gfc_find_typebound_dtio_proc (gfc_symbol *, bool, bool); +gfc_symbol* gfc_find_specific_dtio_proc (gfc_symbol*, bool, bool); + /* io.c */ extern gfc_st_label format_asterisk; @@ -3195,6 +3287,7 @@ const char *gfc_dt_upper_string (const char *); /* primary.c */ 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); match gfc_match_rvalue (gfc_expr **); match gfc_match_varspec (gfc_expr*, int, bool, bool); int gfc_check_digit (char, int); diff --git a/gcc/fortran/gfortran.info b/gcc/fortran/gfortran.info index 448a3da834..3555386a1f 100644 --- a/gcc/fortran/gfortran.info +++ b/gcc/fortran/gfortran.info @@ -1,7 +1,7 @@ -This is doc/gfortran.info, produced by makeinfo version 4.12 from -/space/rguenther/gcc-6.2.0/gcc-6.2.0/gcc/fortran/gfortran.texi. +This is gfortran.info, produced by makeinfo version 6.1 from +gfortran.texi. -Copyright (C) 1999-2016 Free Software Foundation, Inc. +Copyright (C) 1999-2017 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 @@ -18,20 +18,20 @@ Free Documentation License". (b) The FSF's Back-Cover Text is: You have freedom to copy and modify this GNU Manual, like GNU -software. Copies published by the Free Software Foundation raise -funds for GNU development. - +software. Copies published by the Free Software Foundation raise funds +for GNU development. INFO-DIR-SECTION Software development START-INFO-DIR-ENTRY * gfortran: (gfortran). The GNU Fortran Compiler. END-INFO-DIR-ENTRY + This file documents the use and the internals of the GNU Fortran -compiler, (`gfortran'). +compiler, ('gfortran'). Published by the Free Software Foundation 51 Franklin Street, Fifth Floor Boston, MA 02110-1301 USA - Copyright (C) 1999-2016 Free Software Foundation, Inc. + Copyright (C) 1999-2017 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 @@ -48,8 +48,8 @@ Free Documentation License". (b) The FSF's Back-Cover Text is: You have freedom to copy and modify this GNU Manual, like GNU -software. Copies published by the Free Software Foundation raise -funds for GNU development. +software. Copies published by the Free Software Foundation raise funds +for GNU development. File: gfortran.info, Node: Top, Next: Introduction, Up: (dir) @@ -57,8 +57,8 @@ File: gfortran.info, Node: Top, Next: Introduction, Up: (dir) Introduction ************ -This manual documents the use of `gfortran', the GNU Fortran compiler. -You can find in this manual how to invoke `gfortran', as well as its +This manual documents the use of 'gfortran', the GNU Fortran compiler. +You can find in this manual how to invoke 'gfortran', as well as its features and incompatibilities. * Menu: @@ -66,7 +66,7 @@ features and incompatibilities. * Introduction:: Part I: Invoking GNU Fortran -* Invoking GNU Fortran:: Command options supported by `gfortran'. +* Invoking GNU Fortran:: Command options supported by 'gfortran'. * Runtime:: Influencing runtime behavior with environment variables. Part II: Language Reference @@ -94,7 +94,7 @@ File: gfortran.info, Node: Introduction, Next: Invoking GNU Fortran, Prev: To ************** The GNU Fortran compiler front end was designed initially as a free -replacement for, or alternative to, the Unix `f95' command; `gfortran' +replacement for, or alternative to, the Unix 'f95' command; 'gfortran' is the command you will use to invoke the compiler. * Menu: @@ -117,74 +117,74 @@ completely, parts of the Fortran 2003 and Fortran 2008 standards, and several vendor extensions. The development goal is to provide the following features: - * Read a user's program, stored in a file and containing - instructions written in Fortran 77, Fortran 90, Fortran 95, - Fortran 2003 or Fortran 2008. This file contains "source code". + * Read a user's program, stored in a file and containing instructions + written in Fortran 77, Fortran 90, Fortran 95, Fortran 2003 or + Fortran 2008. This file contains "source code". - * Translate the user's 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 - "machine code", code designed to be 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. + * Translate the user's 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 "machine + code", code designed to be 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. * 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. An incorrect usage of the language causes - an "error message". + mistakes to the user. An incorrect usage of the language causes an + "error message". The compiler will also attempt to diagnose cases where the user's - program contains a correct usage of the language, but instructs - the computer to do something questionable. This kind of - diagnostics message is called a "warning message". + program contains a correct usage of the language, but instructs the + computer to do something questionable. This kind of diagnostics + message is called a "warning message". * 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 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. + 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. * Provide information in the generated machine code that can make it easier to find bugs in the program (using a debugging tool, called - a "debugger", such as the GNU Debugger `gdb'). + a "debugger", such as the GNU Debugger 'gdb'). - * Locate and gather machine code already generated to perform - actions requested by statements in the user's program. This - machine code is organized into "modules" and is located and - "linked" to the user program. + * Locate and gather machine code already generated to perform actions + requested by statements in the user's program. This machine code + is organized into "modules" and is located and "linked" to the user + program. The GNU Fortran compiler consists of several components: - * A version of the `gcc' command (which also might be installed as - the system's `cc' command) that also understands and accepts - Fortran source code. The `gcc' command is the "driver" program for - all the languages in the GNU Compiler Collection (GCC); With `gcc', + * A version of the 'gcc' command (which also might be installed as + the system's 'cc' command) that also understands and accepts + Fortran source code. The 'gcc' command is the "driver" program for + all the languages in the GNU Compiler Collection (GCC); With 'gcc', you can compile the source code of any language for which a front end is available in GCC. - * The `gfortran' command itself, which also might be installed as the - system's `f95' command. `gfortran' is just another driver program, + * The 'gfortran' command itself, which also might be installed as the + system's 'f95' command. 'gfortran' is just another driver program, but specifically for the Fortran compiler only. The difference - with `gcc' is that `gfortran' will automatically link the correct + with 'gcc' is that 'gfortran' will automatically link the correct libraries to your program. * A collection of run-time libraries. These libraries contain the - machine code needed to support capabilities of the Fortran - language that are not directly provided by the machine code - generated by the `gfortran' compilation phase, such as intrinsic - functions and subroutines, and routines for interaction with files - and the operating system. + machine code needed to support capabilities of the Fortran language + that are not directly provided by the machine code generated by the + 'gfortran' compilation phase, such as intrinsic functions and + subroutines, and routines for interaction with files and the + operating system. - * The Fortran compiler itself, (`f951'). This is the GNU Fortran + * The Fortran compiler itself, ('f951'). This is the GNU Fortran parser and code generator, linked to and interfaced with the GCC - backend library. `f951' "translates" the source code to assembler + backend library. 'f951' "translates" the source code to assembler code. You would typically not use this program directly; instead, - the `gcc' or `gfortran' driver programs will call it for you. + the 'gcc' or 'gfortran' driver programs will call it for you. File: gfortran.info, Node: GNU Fortran and GCC, Next: Preprocessing and conditional compilation, Prev: About GNU Fortran, Up: Introduction @@ -195,36 +195,36 @@ File: gfortran.info, Node: GNU Fortran and GCC, Next: Preprocessing and condit GNU Fortran is a part of GCC, the "GNU Compiler Collection". GCC consists of a collection of front ends for various languages, which translate the source code into a language-independent form called -"GENERIC". This is then processed by a common middle end which -provides optimization, and then passed to one of a collection of back -ends which generate code for different computer architectures and -operating systems. - - Functionally, this is implemented with a driver program (`gcc') -which provides the command-line interface for the compiler. It calls -the relevant compiler front-end program (e.g., `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, `gcc' will -recognize files with `.f', `.for', `.ftn', `.f90', `.f95', `.f03' and -`.f08' extensions as Fortran source code, and compile it accordingly. -A `gfortran' driver program is also provided, which is identical to -`gcc' except that it automatically links the Fortran runtime libraries -into the compiled program. - - Source files with `.f', `.for', `.fpp', `.ftn', `.F', `.FOR', -`.FPP', and `.FTN' extensions are treated as fixed form. Source files -with `.f90', `.f95', `.f03', `.f08', `.F90', `.F95', `.F03' and `.F08' -extensions are treated as free form. The capitalized versions of -either form are run through preprocessing. Source files with the lower -case `.fpp' extension are also run through preprocessing. +"GENERIC". This is then processed by a common middle end which provides +optimization, and then passed to one of a collection of back ends which +generate code for different computer architectures and operating +systems. + + Functionally, this is implemented with a driver program ('gcc') which +provides the command-line interface for the compiler. It calls the +relevant compiler front-end program (e.g., '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, 'gcc' will +recognize files with '.f', '.for', '.ftn', '.f90', '.f95', '.f03' and +'.f08' extensions as Fortran source code, and compile it accordingly. A +'gfortran' driver program is also provided, which is identical to 'gcc' +except that it automatically links the Fortran runtime libraries into +the compiled program. + + Source files with '.f', '.for', '.fpp', '.ftn', '.F', '.FOR', '.FPP', +and '.FTN' extensions are treated as fixed form. Source files with +'.f90', '.f95', '.f03', '.f08', '.F90', '.F95', '.F03' and '.F08' +extensions are treated as free form. The capitalized versions of either +form are run through preprocessing. Source files with the lower case +'.fpp' 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 +handles the programming language's syntax and semantics. The aspects of +GCC which relate to the optimization passes and the back-end code generation are documented in the GCC manual; see *note Introduction: -(gcc)Top. The two manuals together provide a complete reference for -the GNU Fortran compiler. +(gcc)Top. The two manuals together provide a complete reference for the +GNU Fortran compiler. File: gfortran.info, Node: Preprocessing and conditional compilation, Next: GNU Fortran and G77, Prev: GNU Fortran and GCC, Up: Introduction @@ -234,30 +234,29 @@ File: gfortran.info, Node: Preprocessing and conditional compilation, Next: GN 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 `.F', `.FOR', -`.FTN', `.fpp', `.FPP', `.F90', `.F95', `.F03' or `.F08'. To manually -invoke the preprocessor on any file, use `-cpp', to disable -preprocessing on files where the preprocessor is run automatically, use -`-nocpp'. +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 '.F', '.FOR', '.FTN', +'.fpp', '.FPP', '.F90', '.F95', '.F03' or '.F08'. To manually invoke +the preprocessor on any file, use '-cpp', to disable preprocessing on +files where the preprocessor is run automatically, use '-nocpp'. If a preprocessed file includes another file with the Fortran -`INCLUDE' statement, the included file is not preprocessed. To +'INCLUDE' statement, the included file is not preprocessed. To preprocess included files, use the equivalent preprocessor statement -`#include'. +'#include'. - If GNU Fortran invokes the preprocessor, `__GFORTRAN__' is defined -and `__GNUC__', `__GNUC_MINOR__' and `__GNUC_PATCHLEVEL__' can be used -to determine the version of the compiler. See *note Overview: -(cpp)Top. for details. + If GNU Fortran invokes the preprocessor, '__GFORTRAN__' is defined +and '__GNUC__', '__GNUC_MINOR__' and '__GNUC_PATCHLEVEL__' can be used +to determine the version of the compiler. See *note Overview: (cpp)Top. +for details. 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 (`http://www.daniellnagle.com/coco.html'). +preprocess such files (<http://www.daniellnagle.com/coco.html>). File: gfortran.info, Node: GNU Fortran and G77, Next: Project Status, Prev: Preprocessing and conditional compilation, Up: Introduction @@ -265,12 +264,12 @@ File: gfortran.info, Node: GNU Fortran and G77, Next: Project Status, Prev: P 1.4 GNU Fortran and G77 ======================= -The GNU Fortran compiler is the successor to `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 `g77'. +The GNU Fortran compiler is the successor to '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 'g77'. File: gfortran.info, Node: Project Status, Next: Standards, Prev: GNU Fortran and G77, Up: Introduction @@ -278,16 +277,16 @@ File: gfortran.info, Node: Project Status, Next: Standards, Prev: GNU Fortran 1.5 Project Status ================== - As soon as `gfortran' can parse all of the statements correctly, - it will be in the "larva" state. When we generate code, the - "puppa" state. When `gfortran' is done, we'll see if it will be a + As soon as 'gfortran' can parse all of the statements correctly, it + will be in the "larva" state. When we generate code, the "puppa" + state. When 'gfortran' is done, we'll see if it will be a beautiful butterfly, or just a big bug.... -Andy Vaught, April 2000 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). +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, @@ -296,9 +295,9 @@ 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. Note that this is -an experimental feature, incomplete, and subject to change in future -versions of GCC. See `https://gcc.gnu.org/wiki/OpenACC' for more +edges. There also is initial support for OpenACC. Note that this is an +experimental feature, incomplete, and subject to change in future +versions of GCC. See <https://gcc.gnu.org/wiki/OpenACC> for more information. At present, the GNU Fortran compiler passes the NIST Fortran 77 Test @@ -313,12 +312,12 @@ compile a number of large real-world programs, including the HARMONIE and HIRLAM weather forecasting code (http://hirlam.org/) and the Tonto quantum chemistry package (http://physical-chemistry.scb.uwa.edu.au/tonto/wiki/index.php/Main_Page); -see `https://gcc.gnu.org/wiki/GfortranApps' for an extended list. +see <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. +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 @@ -337,27 +336,27 @@ File: gfortran.info, Node: Standards, Prev: Project Status, Up: Introduction * Varying Length Character Strings:: - 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 +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 `Further Interoperability of Fortran with C' (ISO/IEC TS +Specification '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 *note Fortran 2003 status::, *note Fortran 2008 status::, -*note TS 29113 status:: and *note TS 18508 status:: sections of the +standards is planned. The current status of the support is can be found +in the *note Fortran 2003 status::, *note Fortran 2008 status::, *note +TS 29113 status:: and *note TS 18508 status:: sections of the documentation. Additionally, the GNU Fortran compilers supports the OpenMP -specification (version 4.0, -`http://openmp.org/wp/openmp-specifications/'). There also is initial +specification (version 4.0 and most of the features of the 4.5 version, +<http://openmp.org/wp/openmp-specifications/>). There also is initial support for the OpenACC specification (targeting version 2.0, -`http://www.openacc.org/'). Note that this is an experimental feature, -incomplete, and subject to change in future versions of GCC. See -`https://gcc.gnu.org/wiki/OpenACC' for more information. +<http://www.openacc.org/>). Note that this is an experimental feature, +incomplete, and subject to change in future versions of GCC. See +<https://gcc.gnu.org/wiki/OpenACC> for more information. File: gfortran.info, Node: Varying Length Character Strings, Up: Standards @@ -369,13 +368,13 @@ 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 -`http://www.fortran.com/iso_varying_string.f95' and at -`ftp://ftp.nag.co.uk/sc22wg5/ISO_VARYING_STRING/'. +<http://www.fortran.com/iso_varying_string.f95> and at +<ftp://ftp.nag.co.uk/sc22wg5/ISO_VARYING_STRING/>. Deferred-length character strings of Fortran 2003 supports part of -the features of `ISO_VARYING_STRING' and should be considered as -replacement. (Namely, allocatable or pointers of the type -`character(len=:)'.) +the features of 'ISO_VARYING_STRING' and should be considered as +replacement. (Namely, allocatable or pointers of the type +'character(len=:)'.) File: gfortran.info, Node: Invoking GNU Fortran, Next: Runtime, Prev: Introduction, Up: Top @@ -383,25 +382,25 @@ File: gfortran.info, Node: Invoking GNU Fortran, Next: Runtime, Prev: Introdu 2 GNU Fortran Command Options ***************************** -The `gfortran' command supports all the options supported by the `gcc' +The 'gfortran' command supports all the options supported by the 'gcc' command. Only options specific to GNU Fortran are documented here. *Note GCC Command Options: (gcc)Invoking GCC, for information on the -non-Fortran-specific aspects of the `gcc' command (and, therefore, the -`gfortran' command). +non-Fortran-specific aspects of the 'gcc' command (and, therefore, the +'gfortran' command). - All GCC and GNU Fortran options are accepted both by `gfortran' and -by `gcc' (as well as any other drivers built at the same time, such as -`g++'), since adding GNU Fortran to the GCC distribution enables + All GCC and GNU Fortran options are accepted both by 'gfortran' and +by 'gcc' (as well as any other drivers built at the same time, such as +'g++'), since adding GNU Fortran to the GCC distribution enables acceptance of GNU Fortran options by all of the relevant drivers. - In some cases, options have positive and negative forms; the -negative form of `-ffoo' would be `-fno-foo'. This manual documents -only one of these two forms, whichever one is not the default. + In some cases, options have positive and negative forms; the negative +form of '-ffoo' would be '-fno-foo'. This manual documents only one of +these two forms, whichever one is not the default. * Menu: -* Option Summary:: Brief list of all `gfortran' options, +* Option Summary:: Brief list of all 'gfortran' options, without explanations. * Fortran Dialect Options:: Controlling the variant of Fortran language compiled. @@ -413,7 +412,7 @@ only one of these two forms, whichever one is not the default. * Runtime Options:: Influencing runtime behavior * Code Gen Options:: Specifying conventions for function calls, data layout and register usage. -* Environment Variables:: Environment variables that affect `gfortran'. +* Environment Variables:: Environment variables that affect 'gfortran'. File: gfortran.info, Node: Option Summary, Next: Fortran Dialect Options, Up: Invoking GNU Fortran @@ -421,20 +420,23 @@ File: gfortran.info, Node: Option Summary, Next: Fortran Dialect Options, Up: 2.1 Option summary ================== -Here is a summary of all the options specific to GNU Fortran, grouped -by type. Explanations are in the following sections. +Here is a summary of all the options specific to GNU Fortran, grouped by +type. Explanations are in the following sections. _Fortran Language Options_ *Note Options controlling Fortran dialect: Fortran Dialect Options. -fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code -fd-lines-as-comments - -fdec -fdec-structure -fdefault-double-8 -fdefault-integer-8 + -fdec -fdec-structure -fdec-intrinsic-ints -fdec-static -fdec-math + -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 -fdollar-ok -ffixed-line-length-N -ffixed-line-length-none -ffree-form -ffree-line-length-N -ffree-line-length-none -fimplicit-none -finteger-4-integer-8 -fmax-identifier-length -fmodule-private -ffixed-form -fno-range-check -fopenacc -fopenmp -freal-4-real-10 -freal-4-real-16 -freal-4-real-8 -freal-8-real-10 -freal-8-real-16 -freal-8-real-4 -std=STD + -ftest-forall-temp + _Preprocessing Options_ *Note Enable and customize preprocessing: Preprocessing Options. @@ -447,10 +449,11 @@ _Preprocessing Options_ -nostdinc -undef + _Error and Warning Options_ - *Note Options to request or suppress errors and warnings: Error - and Warning Options. - -Waliasing -Wall -Wampersand -Warray-bounds + *Note Options to request or suppress errors and warnings: Error and + Warning Options. + -Waliasing -Wall -Wampersand -Wargument-mismatch -Warray-bounds -Wc-binding-type -Wcharacter-truncation -Wconversion -Wfunction-elimination -Wimplicit-interface -Wimplicit-procedure -Wintrinsic-shadow -Wuse-without-only -Wintrinsics-std @@ -458,12 +461,14 @@ _Error and Warning Options_ -Wsurprising -Wunderflow -Wunused-parameter -Wrealloc-lhs -Wrealloc-lhs-all -Wtarget-lifetime -fmax-errors=N -fsyntax-only -pedantic -pedantic-errors + _Debugging Options_ *Note Options for debugging your program or GNU Fortran: Debugging Options. -fbacktrace -fdump-fortran-optimized -fdump-fortran-original -fdump-parse-tree -ffpe-trap=LIST -ffpe-summary=LIST + _Directory Options_ *Note Options for directory search: Directory Options. -IDIR -JDIR -fintrinsic-modules-path DIR @@ -477,6 +482,7 @@ _Runtime Options_ -fconvert=CONVERSION -fmax-subrecord-length=LENGTH -frecord-marker=LENGTH -fsign-zero + _Code Generation Options_ *Note Options for code generation conventions: Code Gen Options. -faggressive-function-elimination -fblas-matmul-limit=N @@ -485,6 +491,7 @@ _Code Generation Options_ -fcoarray=<NONE|SINGLE|LIB> -fexternal-blas -ff2c -ffrontend-optimize -finit-character=N -finit-integer=N -finit-local-zero + -finit-derived -finit-logical=<TRUE|FALSE> -finit-real=<ZERO|INF|-INF|NAN|SNAN> -finline-matmul-limit=N @@ -504,203 +511,222 @@ File: gfortran.info, Node: Fortran Dialect Options, Next: Preprocessing Option The following options control the details of the Fortran dialect accepted by the compiler: -`-ffree-form' -`-ffixed-form' +'-ffree-form' +'-ffixed-form' Specify the layout used by the source file. The free form layout was introduced in Fortran 90. Fixed form was traditionally used in older Fortran programs. When neither option is specified, the source form is determined by the file extension. -`-fall-intrinsics' +'-fall-intrinsics' This option causes all intrinsic procedures (including the GNU-specific extensions) to be accepted. This can be useful with - `-std=f95' to force standard-compliance but get access to the full - range of intrinsics available with `gfortran'. As a consequence, - `-Wintrinsics-std' will be ignored and no user-defined procedure + '-std=f95' to force standard-compliance but get access to the full + range of intrinsics available with 'gfortran'. As a consequence, + '-Wintrinsics-std' will be ignored and no user-defined procedure with the same name as any intrinsic will be called except when it - is explicitly declared `EXTERNAL'. + is explicitly declared 'EXTERNAL'. -`-fd-lines-as-code' -`-fd-lines-as-comments' - Enable special treatment for lines beginning with `d' or `D' in - fixed form sources. If the `-fd-lines-as-code' option is given +'-fd-lines-as-code' +'-fd-lines-as-comments' + Enable special treatment for lines beginning with 'd' or 'D' in + fixed form sources. If the '-fd-lines-as-code' option is given they are treated as if the first column contained a blank. If the - `-fd-lines-as-comments' option is given, they are treated as + '-fd-lines-as-comments' option is given, they are treated as comment lines. -`-fdec' - DEC compatibility mode. Enables extensions and other features that - mimic the default behavior of older compilers (such as DEC). - These features are non-standard and should be avoided at all costs. - For details on GNU Fortran's implementation of these extensions +'-fdec' + DEC compatibility mode. Enables extensions and other features that + mimic the default behavior of older compilers (such as DEC). These + features are non-standard and should be avoided at all costs. For + details on GNU Fortran's implementation of these extensions see the + full documentation. + + Other flags enabled by this switch are: '-fdollar-ok' + '-fcray-pointer' '-fdec-structure' '-fdec-intrinsic-ints' + '-fdec-static' '-fdec-math' + + If '-fd-lines-as-code'/'-fd-lines-as-comments' are unset, then + '-fdec' also sets '-fd-lines-as-comments'. + +'-fdec-structure' + Enable DEC 'STRUCTURE' and 'RECORD' as well as 'UNION', 'MAP', and + dot ('.') as a member separator (in addition to '%'). This is + provided for compatibility only; Fortran 90 derived types should be + used instead where possible. + +'-fdec-intrinsic-ints' + Enable B/I/J/K kind variants of existing integer functions (e.g. + BIAND, IIAND, JIAND, etc...). For a complete list of intrinsics see the full documentation. - Other flags enabled by this switch are: `-fdollar-ok' - `-fcray-pointer' `-fdec-structure' +'-fdec-math' + Enable legacy math intrinsics such as COTAN and degree-valued + trigonometric functions (e.g. TAND, ATAND, etc...) for + compatability with older code. -`-fdec-structure' - Enable DEC `STRUCTURE' and `RECORD' as well as `UNION', `MAP', and - dot ('.') as a member separator (in addition to '%'). This is - provided for compatibility only; Fortran 90 derived types should - be used instead where possible. +'-fdec-static' + Enable DEC-style STATIC and AUTOMATIC attributes to explicitly + specify the storage of variables and other objects. -`-fdollar-ok' - Allow `$' as a valid non-first character in a symbol name. Symbols - that start with `$' are rejected since it is unclear which rules to +'-fdollar-ok' + Allow '$' as a valid non-first character in a symbol name. Symbols + that start with '$' are rejected since it is unclear which rules to apply to implicit typing as different vendors implement different - rules. Using `$' in `IMPLICIT' statements is also rejected. + rules. Using '$' in 'IMPLICIT' statements is also rejected. -`-fbackslash' +'-fbackslash' Change the interpretation of backslashes in string literals from a - single backslash character to "C-style" escape characters. The - following combinations are expanded `\a', `\b', `\f', `\n', `\r', - `\t', `\v', `\\', and `\0' to the ASCII characters alert, + single backslash character to "C-style" escape characters. The + following combinations are expanded '\a', '\b', '\f', '\n', '\r', + '\t', '\v', '\\', and '\0' to the ASCII characters alert, backspace, form feed, newline, carriage return, horizontal tab, vertical tab, backslash, and NUL, respectively. Additionally, - `\x'NN, `\u'NNNN and `\U'NNNNNNNN (where each N is a hexadecimal + '\x'NN, '\u'NNNN and '\U'NNNNNNNN (where each N is a hexadecimal digit) are translated into the Unicode characters corresponding to - the specified code points. All other combinations of a character + the specified code points. All other combinations of a character preceded by \ are unexpanded. -`-fmodule-private' - Set the default accessibility of module entities to `PRIVATE'. +'-fmodule-private' + Set the default accessibility of module entities to 'PRIVATE'. Use-associated entities will not be accessible unless they are - explicitly declared as `PUBLIC'. + explicitly declared as 'PUBLIC'. -`-ffixed-line-length-N' +'-ffixed-line-length-N' Set column after which characters are ignored in typical fixed-form lines in the source file, and through which spaces are assumed (as if padded to that length) after the ends of short fixed-form lines. Popular values for N include 72 (the standard and the default), 80 (card image), and 132 (corresponding to "extended-source" options - in some popular compilers). N may also be `none', meaning that - the entire line is meaningful and that continued character - constants never have implicit spaces appended to them to fill out - the line. `-ffixed-line-length-0' means the same thing as - `-ffixed-line-length-none'. + in some popular compilers). N may also be 'none', meaning that the + entire line is meaningful and that continued character constants + never have implicit spaces appended to them to fill out the line. + '-ffixed-line-length-0' means the same thing as + '-ffixed-line-length-none'. -`-ffree-line-length-N' +'-ffree-line-length-N' Set column after which characters are ignored in typical free-form - lines in the source file. The default value is 132. N may be - `none', meaning that the entire line is meaningful. - `-ffree-line-length-0' means the same thing as - `-ffree-line-length-none'. + lines in the source file. The default value is 132. N may be + 'none', meaning that the entire line is meaningful. + '-ffree-line-length-0' means the same thing as + '-ffree-line-length-none'. -`-fmax-identifier-length=N' - Specify the maximum allowed identifier length. Typical values are +'-fmax-identifier-length=N' + Specify the maximum allowed identifier length. Typical values are 31 (Fortran 95) and 63 (Fortran 2003 and Fortran 2008). -`-fimplicit-none' +'-fimplicit-none' Specify that no implicit typing is allowed, unless overridden by - explicit `IMPLICIT' statements. This is the equivalent of adding - `implicit none' to the start of every procedure. + explicit 'IMPLICIT' statements. This is the equivalent of adding + 'implicit none' to the start of every procedure. -`-fcray-pointer' +'-fcray-pointer' Enable the Cray pointer extension, which provides C-like pointer functionality. -`-fopenacc' - Enable the OpenACC extensions. This includes OpenACC `!$acc' - directives in free form and `c$acc', `*$acc' and `!$acc' - directives in fixed form, `!$' conditional compilation sentinels - in free form and `c$', `*$' and `!$' sentinels in fixed form, and - when linking arranges for the OpenACC runtime library to be linked - in. +'-fopenacc' + Enable the OpenACC extensions. This includes OpenACC '!$acc' + directives in free form and 'c$acc', '*$acc' and '!$acc' directives + in fixed form, '!$' conditional compilation sentinels in free form + and 'c$', '*$' and '!$' sentinels in fixed form, and when linking + arranges for the OpenACC runtime library to be linked in. Note that this is an experimental feature, incomplete, and subject - to change in future versions of GCC. See - `https://gcc.gnu.org/wiki/OpenACC' for more information. - -`-fopenmp' - Enable the OpenMP extensions. This includes OpenMP `!$omp' - directives in free form and `c$omp', `*$omp' and `!$omp' - directives in fixed form, `!$' conditional compilation sentinels - in free form and `c$', `*$' and `!$' sentinels in fixed form, and - when linking arranges for the OpenMP runtime library to be linked - in. The option `-fopenmp' implies `-frecursive'. - -`-fno-range-check' + to change in future versions of GCC. See + <https://gcc.gnu.org/wiki/OpenACC> for more information. + +'-fopenmp' + Enable the OpenMP extensions. This includes OpenMP '!$omp' + directives in free form and 'c$omp', '*$omp' and '!$omp' directives + in fixed form, '!$' conditional compilation sentinels in free form + and 'c$', '*$' and '!$' sentinels in fixed form, and when linking + arranges for the OpenMP runtime library to be linked in. The + option '-fopenmp' implies '-frecursive'. + +'-fno-range-check' Disable range checking on results of simplification of constant expressions during compilation. For example, GNU Fortran will give - an error at compile time when simplifying `a = 1. / 0'. With this - option, no error will be given and `a' will be assigned the value - `+Infinity'. If an expression evaluates to a value outside of the - relevant range of [`-HUGE()':`HUGE()'], then the expression will - be replaced by `-Inf' or `+Inf' as appropriate. Similarly, `DATA - i/Z'FFFFFFFF'/' will result in an integer overflow on most - systems, but with `-fno-range-check' the value will "wrap around" - and `i' will be initialized to -1 instead. - -`-fdefault-integer-8' + an error at compile time when simplifying 'a = 1. / 0'. With this + option, no error will be given and 'a' will be assigned the value + '+Infinity'. If an expression evaluates to a value outside of the + relevant range of ['-HUGE()':'HUGE()'], then the expression will be + replaced by '-Inf' or '+Inf' as appropriate. Similarly, 'DATA + i/Z'FFFFFFFF'/' will result in an integer overflow on most systems, + but with '-fno-range-check' the value will "wrap around" and 'i' + will be initialized to -1 instead. + +'-fdefault-integer-8' Set the default integer and logical types to an 8 byte wide type. - This option also affects the kind of integer constants like `42'. - Unlike `-finteger-4-integer-8', it does not promote variables with + This option also affects the kind of integer constants like '42'. + Unlike '-finteger-4-integer-8', it does not promote variables with explicit kind declaration. -`-fdefault-real-8' - Set the default real type to an 8 byte wide type. This option also - affects the kind of non-double real constants like `1.0', and does - promote the default width of `DOUBLE PRECISION' to 16 bytes if - possible, unless `-fdefault-double-8' is given, too. Unlike - `-freal-4-real-8', it does not promote variables with explicit - kind declaration. - -`-fdefault-double-8' - Set the `DOUBLE PRECISION' type to an 8 byte wide type. Do - nothing if this is already the default. If `-fdefault-real-8' is - given, `DOUBLE PRECISION' would instead be promoted to 16 bytes if - possible, and `-fdefault-double-8' can be used to prevent this. - The kind of real constants like `1.d0' will not be changed by - `-fdefault-real-8' though, so also `-fdefault-double-8' does not +'-fdefault-real-8' + Set the default real type to an 8 byte wide type. This option also + affects the kind of non-double real constants like '1.0', and does + promote the default width of 'DOUBLE PRECISION' to 16 bytes if + possible, unless '-fdefault-double-8' is given, too. Unlike + '-freal-4-real-8', it does not promote variables with explicit kind + declaration. + +'-fdefault-double-8' + Set the 'DOUBLE PRECISION' type to an 8 byte wide type. Do nothing + if this is already the default. If '-fdefault-real-8' is given, + 'DOUBLE PRECISION' would instead be promoted to 16 bytes if + possible, and '-fdefault-double-8' can be used to prevent this. + The kind of real constants like '1.d0' will not be changed by + '-fdefault-real-8' though, so also '-fdefault-double-8' does not affect it. -`-finteger-4-integer-8' - Promote all `INTEGER(KIND=4)' entities to an `INTEGER(KIND=8)' - entities. If `KIND=8' is unavailable, then an error will be +'-finteger-4-integer-8' + Promote all 'INTEGER(KIND=4)' entities to an 'INTEGER(KIND=8)' + entities. If 'KIND=8' is unavailable, then an error will be issued. This option should be used with care and may not be suitable for your codes. Areas of possible concern include calls - to external procedures, alignment in `EQUIVALENCE' and/or - `COMMON', generic interfaces, BOZ literal constant conversion, and - I/O. Inspection of the intermediate representation of the - translated Fortran code, produced by `-fdump-tree-original', is - suggested. - -`-freal-4-real-8' -`-freal-4-real-10' -`-freal-4-real-16' -`-freal-8-real-4' -`-freal-8-real-10' -`-freal-8-real-16' - Promote all `REAL(KIND=M)' entities to `REAL(KIND=N)' entities. - If `REAL(KIND=N)' is unavailable, then an error will be issued. - All other real kind types are unaffected by this option. These - options should be used with care and may not be suitable for your - codes. Areas of possible concern include calls to external - procedures, alignment in `EQUIVALENCE' and/or `COMMON', generic - interfaces, BOZ literal constant conversion, and I/O. Inspection - of the intermediate representation of the translated Fortran code, - produced by `-fdump-tree-original', is suggested. - -`-std=STD' + to external procedures, alignment in 'EQUIVALENCE' and/or 'COMMON', + generic interfaces, BOZ literal constant conversion, and I/O. + Inspection of the intermediate representation of the translated + Fortran code, produced by '-fdump-tree-original', is suggested. + +'-freal-4-real-8' +'-freal-4-real-10' +'-freal-4-real-16' +'-freal-8-real-4' +'-freal-8-real-10' +'-freal-8-real-16' + Promote all 'REAL(KIND=M)' entities to 'REAL(KIND=N)' entities. If + 'REAL(KIND=N)' is unavailable, then an error will be issued. All + other real kind types are unaffected by this option. These options + should be used with care and may not be suitable for your codes. + Areas of possible concern include calls to external procedures, + alignment in 'EQUIVALENCE' and/or 'COMMON', generic interfaces, BOZ + literal constant conversion, and I/O. Inspection of the + intermediate representation of the translated Fortran code, + produced by '-fdump-tree-original', is suggested. + +'-std=STD' Specify the standard to which the program is expected to conform, - which may be one of `f95', `f2003', `f2008', `gnu', or `legacy'. - The default value for STD is `gnu', which specifies a superset of + which may be one of 'f95', 'f2003', 'f2008', 'gnu', or 'legacy'. + The default value for STD is 'gnu', which specifies a superset of the Fortran 95 standard that includes all of the extensions supported by GNU Fortran, although warnings will be given for obsolete extensions not recommended for use in new code. The - `legacy' value is equivalent but without the warnings for obsolete + 'legacy' value is equivalent but without the warnings for obsolete extensions, and may be useful for old non-standard programs. The - `f95', `f2003' and `f2008' values specify strict conformance to - the Fortran 95, Fortran 2003 and Fortran 2008 standards, - respectively; errors are given for all extensions beyond the - relevant language standard, and warnings are given for the Fortran - 77 features that are permitted but obsolescent in later standards. - `-std=f2008ts' allows the Fortran 2008 standard including the - additions of the Technical Specification (TS) 29113 on Further - Interoperability of Fortran with C and TS 18508 on Additional - Parallel Features in Fortran. + 'f95', 'f2003' and 'f2008' values specify strict conformance to the + Fortran 95, Fortran 2003 and Fortran 2008 standards, respectively; + errors are given for all extensions beyond the relevant language + standard, and warnings are given for the Fortran 77 features that + are permitted but obsolescent in later standards. '-std=f2008ts' + allows the Fortran 2008 standard including the additions of the + Technical Specification (TS) 29113 on Further Interoperability of + Fortran with C and TS 18508 on Additional Parallel Features in + Fortran. +'-ftest-forall-temp' + Enhance test coverage by forcing most forall assignments to use + temporary. File: gfortran.info, Node: Preprocessing Options, Next: Error and Warning Options, Prev: Fortran Dialect Options, Up: Invoking GNU Fortran @@ -708,158 +734,156 @@ File: gfortran.info, Node: Preprocessing Options, Next: Error and Warning Opti 2.3 Enable and customize preprocessing ====================================== -Preprocessor related options. See section *note Preprocessing and -conditional compilation:: for more detailed information on -preprocessing in `gfortran'. +Preprocessor related options. See section *note Preprocessing and +conditional compilation:: for more detailed information on preprocessing +in 'gfortran'. -`-cpp' -`-nocpp' - Enable preprocessing. The preprocessor is automatically invoked if - the file extension is `.fpp', `.FPP', `.F', `.FOR', `.FTN', - `.F90', `.F95', `.F03' or `.F08'. Use this option to manually - enable preprocessing of any kind of Fortran file. +'-cpp' +'-nocpp' + Enable preprocessing. The preprocessor is automatically invoked if + the file extension is '.fpp', '.FPP', '.F', '.FOR', '.FTN', '.F90', + '.F95', '.F03' or '.F08'. Use this option to manually enable + preprocessing of any kind of Fortran file. To disable preprocessing of files with any of the above listed - extensions, use the negative form: `-nocpp'. + extensions, use the negative form: '-nocpp'. - The preprocessor is run in traditional mode. Any restrictions of + The preprocessor is run in traditional mode. Any restrictions of the file-format, especially the limits on line length, apply for preprocessed output as well, so it might be advisable to use the - `-ffree-line-length-none' or `-ffixed-line-length-none' options. + '-ffree-line-length-none' or '-ffixed-line-length-none' options. -`-dM' - Instead of the normal output, generate a list of `'#define'' +'-dM' + Instead of the normal output, generate a list of ''#define'' directives for all the macros defined during the execution of the - preprocessor, including predefined macros. This gives you a way of + preprocessor, including predefined macros. This gives you a way of finding out what is predefined in your version of the preprocessor. - Assuming you have no file `foo.f90', the command + Assuming you have no file 'foo.f90', the command touch foo.f90; gfortran -cpp -E -dM foo.f90 will show all the predefined macros. -`-dD' - Like `-dM' except in two respects: it does not include the - predefined macros, and it outputs both the `#define' directives - and the result of preprocessing. Both kinds of output go to the +'-dD' + Like '-dM' except in two respects: it does not include the + predefined macros, and it outputs both the '#define' directives and + the result of preprocessing. Both kinds of output go to the standard output file. -`-dN' - Like `-dD', but emit only the macro names, not their expansions. +'-dN' + Like '-dD', but emit only the macro names, not their expansions. -`-dU' - Like `dD' except that only macros that are expanded, or whose +'-dU' + Like 'dD' except that only macros that are expanded, or whose definedness is tested in preprocessor directives, are output; the output is delayed until the use or test of the macro; and - `'#undef'' directives are also output for macros tested but + ''#undef'' directives are also output for macros tested but undefined at the time. -`-dI' - Output `'#include'' directives in addition to the result of +'-dI' + Output ''#include'' directives in addition to the result of preprocessing. -`-fworking-directory' +'-fworking-directory' Enable generation of linemarkers in the preprocessor output that will let the compiler know the current working directory at the - time of preprocessing. When this option is enabled, the + time of preprocessing. When this option is enabled, the preprocessor will emit, after the initial linemarker, a second linemarker with the current working directory followed by two - slashes. GCC will use this directory, when it is present in the - preprocessed input, as the directory emitted as the current - working directory in some debugging information formats. This - option is implicitly enabled if debugging information is enabled, - but this can be inhibited with the negated form - `-fno-working-directory'. If the `-P' flag is present in the - command line, this option has no effect, since no `#line' - directives are emitted whatsoever. - -`-idirafter DIR' + slashes. GCC will use this directory, when it is present in the + preprocessed input, as the directory emitted as the current working + directory in some debugging information formats. This option is + implicitly enabled if debugging information is enabled, but this + can be inhibited with the negated form '-fno-working-directory'. + If the '-P' flag is present in the command line, this option has no + effect, since no '#line' directives are emitted whatsoever. + +'-idirafter DIR' Search DIR for include files, but do it after all directories - specified with `-I' and the standard system directories have been - exhausted. DIR is treated as a system include directory. If dir - begins with `=', then the `=' will be replaced by the sysroot - prefix; see `--sysroot' and `-isysroot'. + specified with '-I' and the standard system directories have been + exhausted. DIR is treated as a system include directory. If dir + begins with '=', then the '=' will be replaced by the sysroot + prefix; see '--sysroot' and '-isysroot'. -`-imultilib DIR' +'-imultilib DIR' Use DIR as a subdirectory of the directory containing target-specific C++ headers. -`-iprefix PREFIX' - Specify PREFIX as the prefix for subsequent `-iwithprefix' - options. If the PREFIX represents a directory, you should include - the final `'/''. +'-iprefix PREFIX' + Specify PREFIX as the prefix for subsequent '-iwithprefix' options. + If the PREFIX represents a directory, you should include the final + ''/''. -`-isysroot DIR' - This option is like the `--sysroot' option, but applies only to - header files. See the `--sysroot' option for more information. +'-isysroot DIR' + This option is like the '--sysroot' option, but applies only to + header files. See the '--sysroot' option for more information. -`-iquote DIR' - Search DIR only for header files requested with `#include "file"'; - they are not searched for `#include <file>', before all directories - specified by `-I' and before the standard system directories. If - DIR begins with `=', then the `=' will be replaced by the sysroot - prefix; see `--sysroot' and `-isysroot'. +'-iquote DIR' + Search DIR only for header files requested with '#include "file"'; + they are not searched for '#include <file>', before all directories + specified by '-I' and before the standard system directories. If + DIR begins with '=', then the '=' will be replaced by the sysroot + prefix; see '--sysroot' and '-isysroot'. -`-isystem DIR' +'-isystem DIR' Search DIR for header files, after all directories specified by - `-I' but before the standard system directories. Mark it as a + '-I' but before the standard system directories. Mark it as a system directory, so that it gets the same special treatment as is - applied to the standard system directories. If DIR begins with - `=', then the `=' will be replaced by the sysroot prefix; see - `--sysroot' and `-isysroot'. + applied to the standard system directories. If DIR begins with + '=', then the '=' will be replaced by the sysroot prefix; see + '--sysroot' and '-isysroot'. -`-nostdinc' +'-nostdinc' Do not search the standard system directories for header files. - Only the directories you have specified with `-I' options (and the + Only the directories you have specified with '-I' options (and the directory of the current file, if appropriate) are searched. -`-undef' +'-undef' Do not predefine any system-specific or GCC-specific macros. The standard predefined macros remain defined. -`-APREDICATE=ANSWER' +'-APREDICATE=ANSWER' Make an assertion with the predicate PREDICATE and answer ANSWER. This form is preferred to the older form -A predicate(answer), which is still supported, because it does not use shell special characters. -`-A-PREDICATE=ANSWER' +'-A-PREDICATE=ANSWER' Cancel an assertion with the predicate PREDICATE and answer ANSWER. -`-C' - Do not discard comments. All comments are passed through to the - output file, except for comments in processed directives, which - are deleted along with the directive. +'-C' + Do not discard comments. All comments are passed through to the + output file, except for comments in processed directives, which are + deleted along with the directive. - You should be prepared for side effects when using `-C'; it causes + You should be prepared for side effects when using '-C'; it causes the preprocessor to treat comments as tokens in their own right. For example, comments appearing at the start of what would be a directive line have the effect of turning that line into an ordinary source line, since the first token on the line is no - longer a `'#''. + longer a ''#''. - Warning: this currently handles C-Style comments only. The + Warning: this currently handles C-Style comments only. The preprocessor does not yet recognize Fortran-style comments. -`-CC' - Do not discard comments, including during macro expansion. This is - like `-C', except that comments contained within macros are also +'-CC' + Do not discard comments, including during macro expansion. This is + like '-C', except that comments contained within macros are also passed through to the output file where the macro is expanded. - In addition to the side-effects of the `-C' option, the `-CC' - option causes all C++-style comments inside a macro to be - converted to C-style comments. This is to prevent later use of - that macro from inadvertently commenting out the remainder of the - source line. The `-CC' option is generally used to support lint - comments. + In addition to the side-effects of the '-C' option, the '-CC' + option causes all C++-style comments inside a macro to be converted + to C-style comments. This is to prevent later use of that macro + from inadvertently commenting out the remainder of the source line. + The '-CC' option is generally used to support lint comments. - Warning: this currently handles C- and C++-Style comments only. The - preprocessor does not yet recognize Fortran-style comments. + Warning: this currently handles C- and C++-Style comments only. + The preprocessor does not yet recognize Fortran-style comments. -`-DNAME' - Predefine name as a macro, with definition `1'. +'-DNAME' + Predefine name as a macro, with definition '1'. -`-DNAME=DEFINITION' +'-DNAME=DEFINITION' The contents of DEFINITION are tokenized and processed as if they - appeared during translation phase three in a `'#define'' directive. + appeared during translation phase three in a ''#define'' directive. In particular, the definition will be truncated by embedded newline characters. @@ -869,28 +893,28 @@ preprocessing in `gfortran'. If you wish to define a function-like macro on the command line, write its argument list with surrounding parentheses before the - equals sign (if any). Parentheses are meaningful to most shells, - so you will need to quote the option. With sh and csh, - `-D'name(args...)=definition'' works. + equals sign (if any). Parentheses are meaningful to most shells, + so you will need to quote the option. With sh and csh, + '-D'name(args...)=definition'' works. - `-D' and `-U' options are processed in the order they are given on - the command line. All -imacros file and -include file options are + '-D' and '-U' options are processed in the order they are given on + the command line. All -imacros file and -include file options are processed after all -D and -U options. -`-H' +'-H' Print the name of each header file used, in addition to other - normal activities. Each name is indented to show how deep in the - `'#include'' stack it is. + normal activities. Each name is indented to show how deep in the + ''#include'' stack it is. -`-P' +'-P' Inhibit generation of linemarkers in the output from the preprocessor. This might be useful when running the preprocessor on something that is not C code, and will be sent to a program which might be confused by the linemarkers. -`-UNAME' +'-UNAME' Cancel any previous definition of NAME, either built in or provided - with a `-D' option. + with a '-D' option. File: gfortran.info, Node: Error and Warning Options, Next: Debugging Options, Prev: Preprocessing Options, Up: Invoking GNU Fortran @@ -905,65 +929,67 @@ to aid in debugging, but will not produce any compiled output. Warnings are diagnostic messages that report constructions which are not inherently erroneous but which are risky or suggest there is likely -to be a bug in the program. Unless `-Werror' is specified, they do not +to be a bug in the program. Unless '-Werror' is specified, they do not prevent compilation of the program. - You can request many specific warnings with options beginning `-W', -for example `-Wimplicit' to request warnings on implicit declarations. + You can request many specific warnings with options beginning '-W', +for example '-Wimplicit' to request warnings on implicit declarations. Each of these specific warning options also has a negative form -beginning `-Wno-' to turn off warnings; for example, `-Wno-implicit'. +beginning '-Wno-' to turn off warnings; for example, '-Wno-implicit'. This manual lists only one of the two forms, whichever is not the default. These options control the amount and kinds of errors and warnings produced by GNU Fortran: -`-fmax-errors=N' +'-fmax-errors=N' Limits the maximum number of error messages to N, at which point - GNU Fortran bails out rather than attempting to continue - processing the source code. If N is 0, there is no limit on the - number of error messages produced. + GNU Fortran bails out rather than attempting to continue processing + the source code. If N is 0, there is no limit on the number of + error messages produced. -`-fsyntax-only' +'-fsyntax-only' Check the code for syntax errors, but do not actually compile it. This will generate module files for each module present in the code, but no other output file. -`-pedantic' - Issue warnings for uses of extensions to Fortran 95. `-pedantic' +'-Wpedantic' +'-pedantic' + Issue warnings for uses of extensions to Fortran 95. '-pedantic' also applies to C-language constructs where they occur in GNU - Fortran source files, such as use of `\e' in a character constant - within a directive like `#include'. + Fortran source files, such as use of '\e' in a character constant + within a directive like '#include'. Valid Fortran 95 programs should compile properly with or without this option. However, without this option, certain GNU extensions and traditional Fortran features are supported as well. With this option, many of them are rejected. - Some users try to use `-pedantic' to check programs for + Some users try to use '-pedantic' to check programs for conformance. They soon find that it does not do quite what they want--it finds some nonstandard practices, but not all. However, improvements to GNU Fortran in this area are welcome. - This should be used in conjunction with `-std=f95', `-std=f2003' - or `-std=f2008'. + This should be used in conjunction with '-std=f95', '-std=f2003' or + '-std=f2008'. -`-pedantic-errors' - Like `-pedantic', except that errors are produced rather than +'-pedantic-errors' + Like '-pedantic', except that errors are produced rather than warnings. -`-Wall' +'-Wall' Enables commonly used warning options pertaining to usage that we recommend avoiding and that we believe are easy to avoid. This - currently includes `-Waliasing', `-Wampersand', `-Wconversion', - `-Wsurprising', `-Wc-binding-type', `-Wintrinsics-std', `-Wtabs', - `-Wintrinsic-shadow', `-Wline-truncation', `-Wtarget-lifetime', - `-Winteger-division', `-Wreal-q-constant' and `-Wunused'. - -`-Waliasing' - Warn about possible aliasing of dummy arguments. Specifically, it + currently includes '-Waliasing', '-Wampersand', '-Wconversion', + '-Wsurprising', '-Wc-binding-type', '-Wintrinsics-std', '-Wtabs', + '-Wintrinsic-shadow', '-Wline-truncation', '-Wtarget-lifetime', + '-Winteger-division', '-Wreal-q-constant', '-Wunused' and + '-Wundefined-do-loop'. + +'-Waliasing' + Warn about possible aliasing of dummy arguments. Specifically, it warns if the same actual argument is associated with a dummy - argument with `INTENT(IN)' and a dummy argument with `INTENT(OUT)' + argument with 'INTENT(IN)' and a dummy argument with 'INTENT(OUT)' in a call with an explicit interface. The following example will trigger the warning. @@ -977,74 +1003,79 @@ produced by GNU Fortran: call bar(a,a) -`-Wampersand' - Warn about missing ampersand in continued character constants. The - warning is given with `-Wampersand', `-pedantic', `-std=f95', - `-std=f2003' and `-std=f2008'. Note: With no ampersand given in a +'-Wampersand' + Warn about missing ampersand in continued character constants. The + warning is given with '-Wampersand', '-pedantic', '-std=f95', + '-std=f2003' and '-std=f2008'. Note: With no ampersand given in a continued character constant, GNU Fortran assumes continuation at the first non-comment, non-whitespace character after the ampersand that initiated the continuation. -`-Warray-temporaries' +'-Wargument-mismatch' + Warn about type, rank, and other mismatches between formal + parameters and actual arguments to functions and subroutines. + These warnings are recommended and thus enabled by default. + +'-Warray-temporaries' Warn about array temporaries generated by the compiler. The information generated by this warning is sometimes useful in optimization, in order to avoid such temporaries. -`-Wc-binding-type' +'-Wc-binding-type' Warn if the a variable might not be C interoperable. In particular, warn if the variable has been declared using an intrinsic type with default kind instead of using a kind parameter - defined for C interoperability in the intrinsic `ISO_C_Binding' - module. This option is implied by `-Wall'. + defined for C interoperability in the intrinsic 'ISO_C_Binding' + module. This option is implied by '-Wall'. -`-Wcharacter-truncation' +'-Wcharacter-truncation' Warn when a character assignment will truncate the assigned string. -`-Wline-truncation' +'-Wline-truncation' Warn when a source code line will be truncated. This option is - implied by `-Wall'. For free-form source code, the default is - `-Werror=line-truncation' such that truncations are reported as + implied by '-Wall'. For free-form source code, the default is + '-Werror=line-truncation' such that truncations are reported as error. -`-Wconversion' - Warn about implicit conversions that are likely to change the - value of the expression after conversion. Implied by `-Wall'. +'-Wconversion' + Warn about implicit conversions that are likely to change the value + of the expression after conversion. Implied by '-Wall'. -`-Wconversion-extra' +'-Wconversion-extra' Warn about implicit conversions between different types and kinds. - This option does _not_ imply `-Wconversion'. + This option does _not_ imply '-Wconversion'. -`-Wextra' +'-Wextra' Enables some warning options for usages of language features which - may be problematic. This currently includes `-Wcompare-reals' and - `-Wunused-parameter'. + may be problematic. This currently includes '-Wcompare-reals' and + '-Wunused-parameter'. -`-Wimplicit-interface' +'-Wimplicit-interface' Warn if a procedure is called without an explicit interface. Note this only checks that an explicit interface is present. It does not check that the declared interfaces are consistent across program units. -`-Wimplicit-procedure' +'-Wimplicit-procedure' Warn if a procedure is called that has neither an explicit - interface nor has been declared as `EXTERNAL'. + interface nor has been declared as 'EXTERNAL'. -`-Winteger-division' +'-Winteger-division' Warn if a constant integer division truncates it result. As an example, 3/5 evaluates to 0. -`-Wintrinsics-std' - Warn if `gfortran' finds a procedure named like an intrinsic not - available in the currently selected standard (with `-std') and - treats it as `EXTERNAL' procedure because of this. - `-fall-intrinsics' can be used to never trigger this behavior and +'-Wintrinsics-std' + Warn if 'gfortran' finds a procedure named like an intrinsic not + available in the currently selected standard (with '-std') and + treats it as 'EXTERNAL' procedure because of this. + '-fall-intrinsics' can be used to never trigger this behavior and always link to the intrinsic regardless of the selected standard. -`-Wreal-q-constant' - Produce a warning if a real-literal-constant contains a `q' +'-Wreal-q-constant' + Produce a warning if a real-literal-constant contains a 'q' exponent-letter. -`-Wsurprising' +'-Wsurprising' Produce a warning when "suspicious" code constructs are encountered. While technically legal these usually indicate that an error has been made. @@ -1061,92 +1092,96 @@ produced by GNU Fortran: destination. * The type of a function result is declared more than once with - the same type. If `-pedantic' or standard-conforming mode is + the same type. If '-pedantic' or standard-conforming mode is enabled, this is an error. - * A `CHARACTER' variable is declared with negative length. + * A 'CHARACTER' variable is declared with negative length. -`-Wtabs' +'-Wtabs' By default, tabs are accepted as whitespace, but tabs are not members of the Fortran Character Set. For continuation lines, a - tab followed by a digit between 1 and 9 is supported. `-Wtabs' - will cause a warning to be issued if a tab is encountered. Note, - `-Wtabs' is active for `-pedantic', `-std=f95', `-std=f2003', - `-std=f2008', `-std=f2008ts' and `-Wall'. + tab followed by a digit between 1 and 9 is supported. '-Wtabs' + will cause a warning to be issued if a tab is encountered. Note, + '-Wtabs' is active for '-pedantic', '-std=f95', '-std=f2003', + '-std=f2008', '-std=f2008ts' and '-Wall'. + +'-Wundefined-do-loop' + Warn if a DO loop with step either 1 or -1 yields an underflow or + an overflow during iteration of an induction variable of the loop. + This option is implied by '-Wall'. -`-Wunderflow' +'-Wunderflow' Produce a warning when numerical constant expressions are - encountered, which yield an UNDERFLOW during compilation. Enabled + encountered, which yield an UNDERFLOW during compilation. Enabled by default. -`-Wintrinsic-shadow' +'-Wintrinsic-shadow' Warn if a user-defined procedure or module procedure has the same name as an intrinsic; in this case, an explicit interface or - `EXTERNAL' or `INTRINSIC' declaration might be needed to get calls + 'EXTERNAL' or 'INTRINSIC' declaration might be needed to get calls later resolved to the desired intrinsic/procedure. This option is - implied by `-Wall'. + implied by '-Wall'. -`-Wuse-without-only' - Warn if a `USE' statement has no `ONLY' qualifier and thus +'-Wuse-without-only' + Warn if a 'USE' statement has no 'ONLY' qualifier and thus implicitly imports all public entities of the used module. -`-Wunused-dummy-argument' - Warn about unused dummy arguments. This option is implied by - `-Wall'. +'-Wunused-dummy-argument' + Warn about unused dummy arguments. This option is implied by + '-Wall'. -`-Wunused-parameter' - Contrary to `gcc''s meaning of `-Wunused-parameter', `gfortran''s +'-Wunused-parameter' + Contrary to 'gcc''s meaning of '-Wunused-parameter', 'gfortran''s implementation of this option does not warn about unused dummy - arguments (see `-Wunused-dummy-argument'), but about unused - `PARAMETER' values. `-Wunused-parameter' is implied by `-Wextra' - if also `-Wunused' or `-Wall' is used. + arguments (see '-Wunused-dummy-argument'), but about unused + 'PARAMETER' values. '-Wunused-parameter' is implied by '-Wextra' + if also '-Wunused' or '-Wall' is used. -`-Walign-commons' - By default, `gfortran' warns about any occasion of variables being - padded for proper alignment inside a `COMMON' block. This warning - can be turned off via `-Wno-align-commons'. See also - `-falign-commons'. +'-Walign-commons' + By default, 'gfortran' warns about any occasion of variables being + padded for proper alignment inside a 'COMMON' block. This warning + can be turned off via '-Wno-align-commons'. See also + '-falign-commons'. -`-Wfunction-elimination' +'-Wfunction-elimination' Warn if any calls to functions are eliminated by the optimizations - enabled by the `-ffrontend-optimize' option. + enabled by the '-ffrontend-optimize' option. -`-Wrealloc-lhs' +'-Wrealloc-lhs' Warn when the compiler might insert code to for allocation or reallocation of an allocatable array variable of intrinsic type in - intrinsic assignments. In hot loops, the Fortran 2003 - reallocation feature may reduce the performance. If the array is - already allocated with the correct shape, consider using a - whole-array array-spec (e.g. `(:,:,:)') for the variable on the - left-hand side to prevent the reallocation check. Note that in - some cases the warning is shown, even if the compiler will - optimize reallocation checks away. For instance, when the - right-hand side contains the same variable multiplied by a scalar. - See also `-frealloc-lhs'. - -`-Wrealloc-lhs-all' + intrinsic assignments. In hot loops, the Fortran 2003 reallocation + feature may reduce the performance. If the array is already + allocated with the correct shape, consider using a whole-array + array-spec (e.g. '(:,:,:)') for the variable on the left-hand side + to prevent the reallocation check. Note that in some cases the + warning is shown, even if the compiler will optimize reallocation + checks away. For instance, when the right-hand side contains the + same variable multiplied by a scalar. See also '-frealloc-lhs'. + +'-Wrealloc-lhs-all' Warn when the compiler inserts code to for allocation or reallocation of an allocatable variable; this includes scalars and derived types. -`-Wcompare-reals' +'-Wcompare-reals' Warn when comparing real or complex types for equality or - inequality. This option is implied by `-Wextra'. + inequality. This option is implied by '-Wextra'. -`-Wtarget-lifetime' +'-Wtarget-lifetime' Warn if the pointer in a pointer assignment might be longer than - the its target. This option is implied by `-Wall'. + the its target. This option is implied by '-Wall'. -`-Wzerotrip' - Warn if a `DO' loop is known to execute zero times at compile - time. This option is implied by `-Wall'. +'-Wzerotrip' + Warn if a 'DO' loop is known to execute zero times at compile time. + This option is implied by '-Wall'. -`-Werror' +'-Werror' Turns all warnings into errors. *Note Options to Request or Suppress Errors and Warnings: -(gcc)Warning Options, for information on more options offered by the -GBE shared by `gfortran', `gcc' and other GNU compilers. +(gcc)Warning Options, for information on more options offered by the GBE +shared by 'gfortran', 'gcc' and other GNU compilers. Some of these have no effect when compiling programs written in Fortran. @@ -1160,68 +1195,66 @@ File: gfortran.info, Node: Debugging Options, Next: Directory Options, Prev: GNU Fortran has various special options that are used for debugging either your program or the GNU Fortran compiler. -`-fdump-fortran-original' +'-fdump-fortran-original' Output the internal parse tree after translating the source program into internal representation. Only really useful for debugging the GNU Fortran compiler itself. -`-fdump-fortran-optimized' +'-fdump-fortran-optimized' Output the parse tree after front-end optimization. Only really useful for debugging the GNU Fortran compiler itself. -`-fdump-parse-tree' +'-fdump-parse-tree' Output the internal parse tree after translating the source program into internal representation. Only really useful for debugging the GNU Fortran compiler itself. This option is deprecated; use - `-fdump-fortran-original' instead. + '-fdump-fortran-original' instead. -`-ffpe-trap=LIST' +'-ffpe-trap=LIST' Specify a list of floating point exception traps to enable. On - most systems, if a floating point exception occurs and the trap - for that exception is enabled, a SIGFPE signal will be sent and - the program being aborted, producing a core file useful for - debugging. LIST is a (possibly empty) comma-separated list of the - following exceptions: `invalid' (invalid floating point operation, - such as `SQRT(-1.0)'), `zero' (division by zero), `overflow' - (overflow in a floating point operation), `underflow' (underflow - in a floating point operation), `inexact' (loss of precision - during operation), and `denormal' (operation performed on a - denormal value). The first five exceptions correspond to the five - IEEE 754 exceptions, whereas the last one (`denormal') is not part - of the IEEE 754 standard but is available on some common - architectures such as x86. - - The first three exceptions (`invalid', `zero', and `overflow') + most systems, if a floating point exception occurs and the trap for + that exception is enabled, a SIGFPE signal will be sent and the + program being aborted, producing a core file useful for debugging. + LIST is a (possibly empty) comma-separated list of the following + exceptions: 'invalid' (invalid floating point operation, such as + 'SQRT(-1.0)'), 'zero' (division by zero), 'overflow' (overflow in a + floating point operation), 'underflow' (underflow in a floating + point operation), 'inexact' (loss of precision during operation), + and 'denormal' (operation performed on a denormal value). The + first five exceptions correspond to the five IEEE 754 exceptions, + whereas the last one ('denormal') is not part of the IEEE 754 + standard but is available on some common architectures such as x86. + + The first three exceptions ('invalid', 'zero', and 'overflow') often indicate serious errors, and unless the program has provisions for dealing with these exceptions, enabling traps for these three exceptions is probably a good idea. Many, if not most, floating point operations incur loss of - precision due to rounding, and hence the `ffpe-trap=inexact' is + precision due to rounding, and hence the 'ffpe-trap=inexact' is likely to be uninteresting in practice. By default no exception traps are enabled. -`-ffpe-summary=LIST' +'-ffpe-summary=LIST' Specify a list of floating-point exceptions, whose flag status is - printed to `ERROR_UNIT' when invoking `STOP' and `ERROR STOP'. - LIST can be either `none', `all' or a comma-separated list of the - following exceptions: `invalid', `zero', `overflow', `underflow', - `inexact' and `denormal'. (See `-ffpe-trap' for a description of + printed to 'ERROR_UNIT' when invoking 'STOP' and 'ERROR STOP'. + LIST can be either 'none', 'all' or a comma-separated list of the + following exceptions: 'invalid', 'zero', 'overflow', 'underflow', + 'inexact' and 'denormal'. (See '-ffpe-trap' for a description of the exceptions.) - By default, a summary for all exceptions but `inexact' is shown. + By default, a summary for all exceptions but 'inexact' is shown. -`-fno-backtrace' +'-fno-backtrace' When a serious runtime error is encountered or a deadly signal is emitted (segmentation fault, illegal instruction, bus error, floating-point exception, and the other POSIX signals that have the - action `core'), the Fortran runtime library tries to output a - backtrace of the error. `-fno-backtrace' disables the backtrace - generation. This option only has influence for compilation of the + action 'core'), the Fortran runtime library tries to output a + backtrace of the error. '-fno-backtrace' disables the backtrace + generation. This option only has influence for compilation of the Fortran main program. - *Note Options for Debugging Your Program or GCC: (gcc)Debugging Options, for more information on debugging options. @@ -1231,36 +1264,36 @@ File: gfortran.info, Node: Directory Options, Next: Link Options, Prev: Debug 2.6 Options for directory search ================================ -These options affect how GNU Fortran searches for files specified by -the `INCLUDE' directive and where it searches for previously compiled +These options affect how GNU Fortran searches for files specified by the +'INCLUDE' directive and where it searches for previously compiled modules. - It also affects the search paths used by `cpp' when used to + It also affects the search paths used by 'cpp' when used to preprocess Fortran source. -`-IDIR' - These affect interpretation of the `INCLUDE' directive (as well as - of the `#include' directive of the `cpp' preprocessor). +'-IDIR' + These affect interpretation of the 'INCLUDE' directive (as well as + of the '#include' directive of the 'cpp' preprocessor). - Also note that the general behavior of `-I' and `INCLUDE' is - pretty much the same as of `-I' with `#include' in the `cpp' - preprocessor, with regard to looking for `header.gcc' files and - other such things. + Also note that the general behavior of '-I' and 'INCLUDE' is pretty + much the same as of '-I' with '#include' in the 'cpp' preprocessor, + with regard to looking for 'header.gcc' files and other such + things. - This path is also used to search for `.mod' files when previously - compiled modules are required by a `USE' statement. + This path is also used to search for '.mod' files when previously + compiled modules are required by a 'USE' statement. *Note Options for Directory Search: (gcc)Directory Options, for - information on the `-I' option. + information on the '-I' option. -`-JDIR' - This option specifies where to put `.mod' files for compiled +'-JDIR' + This option specifies where to put '.mod' files for compiled modules. It is also added to the list of directories to searched - by an `USE' statement. + by an 'USE' statement. The default is the current directory. -`-fintrinsic-modules-path DIR' +'-fintrinsic-modules-path DIR' This option specifies the location of pre-compiled intrinsic modules, if they are not in the default location expected by the compiler. @@ -1272,13 +1305,13 @@ File: gfortran.info, Node: Link Options, Next: Runtime Options, Prev: Directo ================================ These options come into play when the compiler links object files into -an executable output file. They are meaningless if the compiler is not +an executable output file. They are meaningless if the compiler is not doing a link step. -`-static-libgfortran' - On systems that provide `libgfortran' as a shared and a static - library, this option forces the use of the static version. If no - shared version of `libgfortran' was built when the compiler was +'-static-libgfortran' + On systems that provide 'libgfortran' as a shared and a static + library, this option forces the use of the static version. If no + shared version of 'libgfortran' was built when the compiler was configured, this option has no effect. @@ -1290,38 +1323,38 @@ File: gfortran.info, Node: Runtime Options, Next: Code Gen Options, Prev: Lin These options affect the runtime behavior of programs compiled with GNU Fortran. -`-fconvert=CONVERSION' +'-fconvert=CONVERSION' Specify the representation of data for unformatted files. Valid - values for conversion are: `native', the default; `swap', swap - between big- and little-endian; `big-endian', use big-endian - representation for unformatted files; `little-endian', use + values for conversion are: 'native', the default; 'swap', swap + between big- and little-endian; 'big-endian', use big-endian + representation for unformatted files; 'little-endian', use little-endian representation for unformatted files. - _This option has an effect only when used in the main program. - The `CONVERT' specifier and the GFORTRAN_CONVERT_UNIT environment - variable override the default specified by `-fconvert'._ + _This option has an effect only when used in the main program. The + 'CONVERT' specifier and the GFORTRAN_CONVERT_UNIT environment + variable override the default specified by '-fconvert'._ -`-frecord-marker=LENGTH' +'-frecord-marker=LENGTH' Specify the length of record markers for unformatted files. Valid values for LENGTH are 4 and 8. Default is 4. _This is different - from previous versions of `gfortran'_, which specified a default + from previous versions of 'gfortran'_, which specified a default record marker length of 8 on most systems. If you want to read or - write files compatible with earlier versions of `gfortran', use - `-frecord-marker=8'. + write files compatible with earlier versions of 'gfortran', use + '-frecord-marker=8'. -`-fmax-subrecord-length=LENGTH' +'-fmax-subrecord-length=LENGTH' Specify the maximum length for a subrecord. The maximum permitted value for length is 2147483639, which is also the default. Only really useful for use by the gfortran testsuite. -`-fsign-zero' +'-fsign-zero' When enabled, floating point numbers of value zero with the sign bit set are written as negative number in formatted output and - treated as negative in the `SIGN' intrinsic. `-fno-sign-zero' - does not print the negative sign of zero values (or values rounded - to zero for I/O) and regards zero as positive number in the `SIGN' - intrinsic for compatibility with Fortran 77. The default is - `-fsign-zero'. + treated as negative in the 'SIGN' intrinsic. '-fno-sign-zero' does + not print the negative sign of zero values (or values rounded to + zero for I/O) and regards zero as positive number in the 'SIGN' + intrinsic for compatibility with Fortran 77. The default is + '-fsign-zero'. File: gfortran.info, Node: Code Gen Options, Next: Environment Variables, Prev: Runtime Options, Up: Invoking GNU Fortran @@ -1329,84 +1362,83 @@ File: gfortran.info, Node: Code Gen Options, Next: Environment Variables, Pre 2.9 Options for code generation conventions =========================================== -These machine-independent options control the interface conventions -used in code generation. +These machine-independent options control the interface conventions used +in code generation. Most of them have both positive and negative forms; the negative form -of `-ffoo' would be `-fno-foo'. In the table below, only one of the +of '-ffoo' would be '-fno-foo'. In the table below, only one of the forms is listed--the one which is not the default. You can figure out -the other form by either removing `no-' or adding it. +the other form by either removing 'no-' or adding it. -`-fno-automatic' +'-fno-automatic' Treat each program unit (except those marked as RECURSIVE) as if - the `SAVE' statement were specified for every local variable and - array referenced in it. Does not affect common blocks. (Some - Fortran compilers provide this option under the name `-static' or - `-save'.) The default, which is `-fautomatic', uses the stack for + the 'SAVE' statement were specified for every local variable and + array referenced in it. Does not affect common blocks. (Some + Fortran compilers provide this option under the name '-static' or + '-save'.) The default, which is '-fautomatic', uses the stack for local variables smaller than the value given by - `-fmax-stack-var-size'. Use the option `-frecursive' to use no + '-fmax-stack-var-size'. Use the option '-frecursive' to use no static memory. -`-ff2c' +'-ff2c' Generate code designed to be compatible with code generated by - `g77' and `f2c'. - - The calling conventions used by `g77' (originally implemented in - `f2c') require functions that return type default `REAL' to - actually return the C type `double', and functions that return - type `COMPLEX' to return the values via an extra argument in the - calling sequence that points to where to store the return value. - Under the default GNU calling conventions, such functions simply - return their results as they would in GNU C--default `REAL' - functions return the C type `float', and `COMPLEX' functions - return the GNU C type `complex'. Additionally, this option - implies the `-fsecond-underscore' option, unless - `-fno-second-underscore' is explicitly requested. + 'g77' and 'f2c'. + + The calling conventions used by 'g77' (originally implemented in + 'f2c') require functions that return type default 'REAL' to + actually return the C type 'double', and functions that return type + 'COMPLEX' to return the values via an extra argument in the calling + sequence that points to where to store the return value. Under the + default GNU calling conventions, such functions simply return their + results as they would in GNU C--default 'REAL' functions return the + C type 'float', and 'COMPLEX' functions return the GNU C type + 'complex'. Additionally, this option implies the + '-fsecond-underscore' option, unless '-fno-second-underscore' is + explicitly requested. This does not affect the generation of code that interfaces with - the `libgfortran' library. + the 'libgfortran' library. _Caution:_ It is not a good idea to mix Fortran code compiled with - `-ff2c' with code compiled with the default `-fno-f2c' calling - conventions as, calling `COMPLEX' or default `REAL' functions + '-ff2c' with code compiled with the default '-fno-f2c' calling + conventions as, calling 'COMPLEX' or default 'REAL' functions between program parts which were compiled with different calling conventions will break at execution time. - _Caution:_ This will break code which passes intrinsic functions - of type default `REAL' or `COMPLEX' as actual arguments, as the - library implementations use the `-fno-f2c' calling conventions. + _Caution:_ This will break code which passes intrinsic functions of + type default 'REAL' or 'COMPLEX' as actual arguments, as the + library implementations use the '-fno-f2c' calling conventions. -`-fno-underscoring' +'-fno-underscoring' Do not transform names of entities specified in the Fortran source file by appending underscores to them. - With `-funderscoring' in effect, GNU Fortran appends one - underscore to external names with no underscores. This is done to - ensure compatibility with code produced by many UNIX Fortran - compilers. + With '-funderscoring' in effect, GNU Fortran appends one underscore + to external names with no underscores. This is done to ensure + compatibility with code produced by many UNIX Fortran compilers. - _Caution_: The default behavior of GNU Fortran is incompatible - with `f2c' and `g77', please use the `-ff2c' option if you want - object files compiled with GNU Fortran to be compatible with - object code created with these tools. + _Caution_: The default behavior of GNU Fortran is incompatible with + 'f2c' and 'g77', please use the '-ff2c' option if you want object + files compiled with GNU Fortran to be compatible with object code + created with these tools. - Use of `-fno-underscoring' is not recommended unless you are + Use of '-fno-underscoring' is not recommended unless you are experimenting with issues such as integration of GNU Fortran into existing system environments (vis-a`-vis existing libraries, tools, and so on). - For example, with `-funderscoring', and assuming that `j()' and - `max_count()' are external functions while `my_var' and `lvar' are + For example, with '-funderscoring', and assuming that 'j()' and + 'max_count()' are external functions while 'my_var' and 'lvar' are local variables, a statement like I = J() + MAX_COUNT (MY_VAR, LVAR) is implemented as something akin to: i = j_() + max_count__(&my_var__, &lvar); - With `-fno-underscoring', the same statement is implemented as: + With '-fno-underscoring', the same statement is implemented as: i = j() + max_count(&my_var, &lvar); - Use of `-fno-underscoring' allows direct specification of + Use of '-fno-underscoring' allows direct specification of user-defined names while debugging and when interfacing GNU Fortran code with other languages. @@ -1414,14 +1446,13 @@ the other form by either removing `no-' or adding it. interface implemented by GNU Fortran for an external name matches the interface implemented by some other language for that same name. That is, getting code produced by GNU Fortran to link to - code produced by some other compiler using this or any other - method can be only a small part of the overall solution--getting - the code generated by both compilers to agree on issues other than - naming can require significant effort, and, unlike naming - disagreements, linkers normally cannot detect disagreements in - these other areas. - - Also, note that with `-fno-underscoring', the lack of appended + code produced by some other compiler using this or any other method + can be only a small part of the overall solution--getting the code + generated by both compilers to agree on issues other than naming + can require significant effort, and, unlike naming disagreements, + linkers normally cannot detect disagreements in these other areas. + + Also, note that with '-fno-underscoring', the lack of appended underscores introduces the very real possibility that a user-defined external name will conflict with a name in a system library, which could make finding unresolved-reference bugs quite @@ -1429,60 +1460,61 @@ the other form by either removing `no-' or adding it. show up only as buggy behavior at run time. In future versions of GNU Fortran we hope to improve naming and - linking issues so that debugging always involves using the names - as they appear in the source, even if the names as seen by the - linker are mangled to prevent accidental linking between - procedures with incompatible interfaces. + linking issues so that debugging always involves using the names as + they appear in the source, even if the names as seen by the linker + are mangled to prevent accidental linking between procedures with + incompatible interfaces. -`-fsecond-underscore' +'-fsecond-underscore' By default, GNU Fortran appends an underscore to external names. - If this option is used GNU Fortran appends two underscores to - names with underscores and one underscore to external names with - no underscores. GNU Fortran also appends two underscores to - internal names with underscores to avoid naming collisions with - external names. + If this option is used GNU Fortran appends two underscores to names + with underscores and one underscore to external names with no + underscores. GNU Fortran also appends two underscores to internal + names with underscores to avoid naming collisions with external + names. - This option has no effect if `-fno-underscoring' is in effect. It - is implied by the `-ff2c' option. + This option has no effect if '-fno-underscoring' is in effect. It + is implied by the '-ff2c' option. - Otherwise, with this option, an external name such as `MAX_COUNT' + Otherwise, with this option, an external name such as 'MAX_COUNT' is implemented as a reference to the link-time external symbol - `max_count__', instead of `max_count_'. This is required for - compatibility with `g77' and `f2c', and is implied by use of the - `-ff2c' option. + 'max_count__', instead of 'max_count_'. This is required for + compatibility with 'g77' and 'f2c', and is implied by use of the + '-ff2c' option. -`-fcoarray=<KEYWORD>' +'-fcoarray=<KEYWORD>' - `none' + 'none' Disable coarray support; using coarray declarations and image-control statements will produce a compile-time error. (Default) - `single' - Single-image mode, i.e. `num_images()' is always one. + 'single' + Single-image mode, i.e. 'num_images()' is always one. - `lib' + 'lib' Library-based coarray parallelization; a suitable GNU Fortran coarray library needs to be linked. -`-fcheck=<KEYWORD>' +'-fcheck=<KEYWORD>' + Enable the generation of run-time checks; the argument shall be a comma-delimited list of the following keywords. Prefixing a check - with `no-' disables it if it was activated by a previous + with 'no-' disables it if it was activated by a previous specification. - `all' - Enable all run-time test of `-fcheck'. + 'all' + Enable all run-time test of '-fcheck'. - `array-temps' + 'array-temps' Warns at run time when for passing an actual argument a - temporary array had to be generated. The information - generated by this warning is sometimes useful in - optimization, in order to avoid such temporaries. + temporary array had to be generated. The information + generated by this warning is sometimes useful in optimization, + in order to avoid such temporaries. Note: The warning is only printed once per location. - `bounds' + 'bounds' Enable generation of run-time checks for array subscripts and against the declared minimum and maximum values. It also checks array indices for assumed and deferred shape arrays @@ -1490,44 +1522,44 @@ the other form by either removing `no-' or adding it. string lengths are equal for character array constructors without an explicit typespec. - Some checks require that `-fcheck=bounds' is set for the + Some checks require that '-fcheck=bounds' is set for the compilation of the main program. Note: In the future this may also include other forms of checking, e.g., checking substring references. - `do' + 'do' Enable generation of run-time checks for invalid modification of loop iteration variables. - `mem' + 'mem' Enable generation of run-time checks for memory allocation. Note: This option does not affect explicit allocations using - the `ALLOCATE' statement, which will be always checked. + the 'ALLOCATE' statement, which will be always checked. - `pointer' + 'pointer' Enable generation of run-time checks for pointers and allocatables. - `recursion' + 'recursion' Enable generation of run-time checks for recursively called subroutines and functions which are not marked as recursive. - See also `-frecursive'. Note: This check does not work for + See also '-frecursive'. Note: This check does not work for OpenMP programs and is disabled if used together with - `-frecursive' and `-fopenmp'. + '-frecursive' and '-fopenmp'. - Example: Assuming you have a file `foo.f90', the command + Example: Assuming you have a file 'foo.f90', the command gfortran -fcheck=all,no-array-temps foo.f90 will compile the file with all checks enabled as specified above except warnings for generated array temporaries. -`-fbounds-check' - Deprecated alias for `-fcheck=bounds'. +'-fbounds-check' + Deprecated alias for '-fcheck=bounds'. -`-fcheck-array-temporaries' - Deprecated alias for `-fcheck=array-temps'. +'-fcheck-array-temporaries' + Deprecated alias for '-fcheck=array-temps'. -`-fmax-array-constructor=N' +'-fmax-array-constructor=N' This option can be used to increase the upper limit permitted in array constructors. The code below requires this option to expand the array at compile time. @@ -1540,18 +1572,18 @@ the other form by either removing `no-' or adding it. print '(10(I0,1X))', i end program test - _Caution: This option can lead to long compile times and + _Caution: This option can lead to long compile times and excessively large object files._ The default value for N is 65535. -`-fmax-stack-var-size=N' +'-fmax-stack-var-size=N' This option specifies the size in bytes of the largest array that will be put on the stack; if the size is exceeded static memory is used (except in procedures marked as RECURSIVE). Use the option - `-frecursive' to allow for recursive procedures which do not have - a RECURSIVE attribute or for parallel programs. Use - `-fno-automatic' to never use the stack. + '-frecursive' to allow for recursive procedures which do not have a + RECURSIVE attribute or for parallel programs. Use '-fno-automatic' + to never use the stack. This option currently only affects local arrays declared with constant bounds, and may not apply to all character variables. @@ -1559,164 +1591,161 @@ the other form by either removing `no-' or adding it. The default value for N is 32768. -`-fstack-arrays' +'-fstack-arrays' Adding this option will make the Fortran compiler put all local arrays, even those of unknown size onto stack memory. If your program uses very large local arrays it is possible that you will have to extend your runtime limits for stack memory on some - operating systems. This flag is enabled by default at optimization - level `-Ofast'. + operating systems. This flag is enabled by default at optimization + level '-Ofast'. -`-fpack-derived' +'-fpack-derived' This option tells GNU Fortran to pack derived type members as closely as possible. Code compiled with this option is likely to be incompatible with code compiled without this option, and may execute slower. -`-frepack-arrays' +'-frepack-arrays' In some circumstances GNU Fortran may pass assumed shape array sections via a descriptor describing a noncontiguous area of memory. This option adds code to the function prologue to repack the data into a contiguous block at runtime. - This should result in faster accesses to the array. However it - can introduce significant overhead to the function call, - especially when the passed data is noncontiguous. + This should result in faster accesses to the array. However it can + introduce significant overhead to the function call, especially + when the passed data is noncontiguous. -`-fshort-enums' +'-fshort-enums' This option is provided for interoperability with C code that was - compiled with the `-fshort-enums' option. It will make GNU - Fortran choose the smallest `INTEGER' kind a given enumerator set - will fit in, and give all its enumerators this kind. + compiled with the '-fshort-enums' option. It will make GNU Fortran + choose the smallest 'INTEGER' kind a given enumerator set will fit + in, and give all its enumerators this kind. -`-fexternal-blas' - This option will make `gfortran' generate calls to BLAS functions - for some matrix operations like `MATMUL', instead of using our own +'-fexternal-blas' + This option will make 'gfortran' generate calls to BLAS functions + for some matrix operations like 'MATMUL', instead of using our own algorithms, if the size of the matrices involved is larger than a - given limit (see `-fblas-matmul-limit'). This may be profitable - if an optimized vendor BLAS library is available. The BLAS - library will have to be specified at link time. + given limit (see '-fblas-matmul-limit'). This may be profitable if + an optimized vendor BLAS library is available. The BLAS library + will have to be specified at link time. -`-fblas-matmul-limit=N' - Only significant when `-fexternal-blas' is in effect. Matrix +'-fblas-matmul-limit=N' + Only significant when '-fexternal-blas' is in effect. Matrix multiplication of matrices with size larger than (or equal to) N will be performed by calls to BLAS functions, while others will be - handled by `gfortran' internal algorithms. If the matrices + handled by 'gfortran' internal algorithms. If the matrices involved are not square, the size comparison is performed using the geometric mean of the dimensions of the argument and result matrices. The default value for N is 30. -`-finline-matmul-limit=N' - When front-end optimiztion is active, some calls to the `MATMUL' +'-finline-matmul-limit=N' + When front-end optimiztion is active, some calls to the 'MATMUL' intrinsic function will be inlined. This may result in code size increase if the size of the matrix cannot be determined at compile time, as code for both cases is generated. Setting - `-finline-matmul-limit=0' will disable inlining in all cases. + '-finline-matmul-limit=0' will disable inlining in all cases. Setting this option with a value of N will produce inline code for - matrices with size up to N. If the matrices involved are not + matrices with size up to N. If the matrices involved are not square, the size comparison is performed using the geometric mean of the dimensions of the argument and result matrices. - The default value for N is the value specified for - `-fblas-matmul-limit' if this option is specified, or unlimitited - otherwise. + The default value for N is 30. The '-fblas-matmul-limit' can be + used to change this value. -`-frecursive' +'-frecursive' Allow indirect recursion by forcing all local arrays to be - allocated on the stack. This flag cannot be used together with - `-fmax-stack-var-size=' or `-fno-automatic'. - -`-finit-local-zero' -`-finit-integer=N' -`-finit-real=<ZERO|INF|-INF|NAN|SNAN>' -`-finit-logical=<TRUE|FALSE>' -`-finit-character=N' - The `-finit-local-zero' option instructs the compiler to - initialize local `INTEGER', `REAL', and `COMPLEX' variables to - zero, `LOGICAL' variables to false, and `CHARACTER' variables to a - string of null bytes. Finer-grained initialization options are - provided by the `-finit-integer=N', - `-finit-real=<ZERO|INF|-INF|NAN|SNAN>' (which also initializes the - real and imaginary parts of local `COMPLEX' variables), - `-finit-logical=<TRUE|FALSE>', and `-finit-character=N' (where N - is an ASCII character value) options. These options do not - initialize + allocated on the stack. This flag cannot be used together with + '-fmax-stack-var-size=' or '-fno-automatic'. + +'-finit-local-zero' +'-finit-derived' +'-finit-integer=N' +'-finit-real=<ZERO|INF|-INF|NAN|SNAN>' +'-finit-logical=<TRUE|FALSE>' +'-finit-character=N' + The '-finit-local-zero' option instructs the compiler to initialize + local 'INTEGER', 'REAL', and 'COMPLEX' variables to zero, 'LOGICAL' + variables to false, and 'CHARACTER' variables to a string of null + bytes. Finer-grained initialization options are provided by the + '-finit-integer=N', '-finit-real=<ZERO|INF|-INF|NAN|SNAN>' (which + also initializes the real and imaginary parts of local 'COMPLEX' + variables), '-finit-logical=<TRUE|FALSE>', and '-finit-character=N' + (where N is an ASCII character value) options. Components of + derived type variables will be initialized according to these flags + only with '-finit-derived'. These options do not initialize * allocatable arrays - - * components of derived type variables - - * variables that appear in an `EQUIVALENCE' statement. + * variables that appear in an 'EQUIVALENCE' statement. (These limitations may be removed in future releases). - Note that the `-finit-real=nan' option initializes `REAL' and - `COMPLEX' variables with a quiet NaN. For a signalling NaN use - `-finit-real=snan'; note, however, that compile-time optimizations + Note that the '-finit-real=nan' option initializes 'REAL' and + 'COMPLEX' variables with a quiet NaN. For a signalling NaN use + '-finit-real=snan'; note, however, that compile-time optimizations may convert them into quiet NaN and that trapping needs to be - enabled (e.g. via `-ffpe-trap'). + enabled (e.g. via '-ffpe-trap'). - Finally, note that enabling any of the `-finit-*' options will - silence warnings that would have been emitted by `-Wuninitialized' + Finally, note that enabling any of the '-finit-*' options will + silence warnings that would have been emitted by '-Wuninitialized' for the affected local variables. -`-falign-commons' - By default, `gfortran' enforces proper alignment of all variables - in a `COMMON' block by padding them as needed. On certain +'-falign-commons' + By default, 'gfortran' enforces proper alignment of all variables + in a 'COMMON' block by padding them as needed. On certain platforms this is mandatory, on others it increases performance. - If a `COMMON' block is not declared with consistent data types + If a 'COMMON' block is not declared with consistent data types everywhere, this padding can cause trouble, and - `-fno-align-commons' can be used to disable automatic alignment. + '-fno-align-commons' can be used to disable automatic alignment. The same form of this option should be used for all files that - share a `COMMON' block. To avoid potential alignment issues in - `COMMON' blocks, it is recommended to order objects from largest - to smallest. + share a 'COMMON' block. To avoid potential alignment issues in + 'COMMON' blocks, it is recommended to order objects from largest to + smallest. -`-fno-protect-parens' +'-fno-protect-parens' By default the parentheses in expression are honored for all optimization levels such that the compiler does not do any - re-association. Using `-fno-protect-parens' allows the compiler to - reorder `REAL' and `COMPLEX' expressions to produce faster code. - Note that for the re-association optimization `-fno-signed-zeros' - and `-fno-trapping-math' need to be in effect. The parentheses - protection is enabled by default, unless `-Ofast' is given. + re-association. Using '-fno-protect-parens' allows the compiler to + reorder 'REAL' and 'COMPLEX' expressions to produce faster code. + Note that for the re-association optimization '-fno-signed-zeros' + and '-fno-trapping-math' need to be in effect. The parentheses + protection is enabled by default, unless '-Ofast' is given. -`-frealloc-lhs' +'-frealloc-lhs' An allocatable left-hand side of an intrinsic assignment is automatically (re)allocated if it is either unallocated or has a - different shape. The option is enabled by default except when - `-std=f95' is given. See also `-Wrealloc-lhs'. + different shape. The option is enabled by default except when + '-std=f95' is given. See also '-Wrealloc-lhs'. -`-faggressive-function-elimination' +'-faggressive-function-elimination' Functions with identical argument lists are eliminated within - statements, regardless of whether these functions are marked - `PURE' or not. For example, in + statements, regardless of whether these functions are marked 'PURE' + or not. For example, in a = f(b,c) + f(b,c) - there will only be a single call to `f'. This option only works - if `-ffrontend-optimize' is in effect. + there will only be a single call to 'f'. This option only works if + '-ffrontend-optimize' is in effect. -`-ffrontend-optimize' +'-ffrontend-optimize' This option performs front-end optimization, based on manipulating - parts the Fortran parse tree. Enabled by default by any `-O' + parts the Fortran parse tree. Enabled by default by any '-O' option. Optimizations enabled by this option include inlining - calls to `MATMUL', elimination of identical function calls within - expressions, removing unnecessary calls to `TRIM' in comparisons - and assignments and replacing `TRIM(a)' with `a(1:LEN_TRIM(a))'. - It can be deselected by specifying `-fno-frontend-optimize'. + calls to 'MATMUL', elimination of identical function calls within + expressions, removing unnecessary calls to 'TRIM' in comparisons + and assignments and replacing 'TRIM(a)' with 'a(1:LEN_TRIM(a))'. + It can be deselected by specifying '-fno-frontend-optimize'. - *Note Options for Code Generation Conventions: (gcc)Code Gen -Options, for information on more options offered by the GBE shared by -`gfortran', `gcc', and other GNU compilers. + *Note Options for Code Generation Conventions: (gcc)Code Gen Options, +for information on more options offered by the GBE shared by 'gfortran', +'gcc', and other GNU compilers. File: gfortran.info, Node: Environment Variables, Prev: Code Gen Options, Up: Invoking GNU Fortran -2.10 Environment variables affecting `gfortran' +2.10 Environment variables affecting 'gfortran' =============================================== -The `gfortran' compiler currently does not make use of any environment +The 'gfortran' compiler currently does not make use of any environment variables to control its operation above and beyond those that affect -the operation of `gcc'. +the operation of 'gcc'. *Note Environment Variables Affecting GCC: (gcc)Environment Variables, for information on environment variables. @@ -1727,10 +1756,10 @@ behavior of programs compiled with GNU Fortran. File: gfortran.info, Node: Runtime, Next: Fortran 2003 and 2008 status, Prev: Invoking GNU Fortran, Up: Top -3 Runtime: Influencing runtime behavior with environment variables -******************************************************************* +3 Runtime: Influencing runtime behavior with environment variables +****************************************************************** -The behavior of the `gfortran' can be influenced by environment +The behavior of the 'gfortran' can be influenced by environment variables. Malformed environment variables are silently ignored. @@ -1753,26 +1782,26 @@ variables. File: gfortran.info, Node: TMPDIR, Next: GFORTRAN_STDIN_UNIT, Up: Runtime -3.1 `TMPDIR'--Directory for scratch files +3.1 'TMPDIR'--Directory for scratch files ========================================= -When opening a file with `STATUS='SCRATCH'', GNU Fortran tries to -create the file in one of the potential directories by testing each -directory in the order below. +When opening a file with 'STATUS='SCRATCH'', GNU Fortran tries to create +the file in one of the potential directories by testing each directory +in the order below. - 1. The environment variable `TMPDIR', if it exists. + 1. The environment variable 'TMPDIR', if it exists. - 2. On the MinGW target, the directory returned by the `GetTempPath' - function. Alternatively, on the Cygwin target, the `TMP' and - `TEMP' environment variables, if they exist, in that order. + 2. On the MinGW target, the directory returned by the 'GetTempPath' + function. Alternatively, on the Cygwin target, the 'TMP' and + 'TEMP' environment variables, if they exist, in that order. - 3. The `P_tmpdir' macro if it is defined, otherwise the directory - `/tmp'. + 3. The 'P_tmpdir' macro if it is defined, otherwise the directory + '/tmp'. File: gfortran.info, Node: GFORTRAN_STDIN_UNIT, Next: GFORTRAN_STDOUT_UNIT, Prev: TMPDIR, Up: Runtime -3.2 `GFORTRAN_STDIN_UNIT'--Unit number for standard input +3.2 'GFORTRAN_STDIN_UNIT'--Unit number for standard input ========================================================= This environment variable can be used to select the unit number @@ -1782,7 +1811,7 @@ default value is 5. File: gfortran.info, Node: GFORTRAN_STDOUT_UNIT, Next: GFORTRAN_STDERR_UNIT, Prev: GFORTRAN_STDIN_UNIT, Up: Runtime -3.3 `GFORTRAN_STDOUT_UNIT'--Unit number for standard output +3.3 'GFORTRAN_STDOUT_UNIT'--Unit number for standard output =========================================================== This environment variable can be used to select the unit number @@ -1792,7 +1821,7 @@ default value is 6. File: gfortran.info, Node: GFORTRAN_STDERR_UNIT, Next: GFORTRAN_UNBUFFERED_ALL, Prev: GFORTRAN_STDOUT_UNIT, Up: Runtime -3.4 `GFORTRAN_STDERR_UNIT'--Unit number for standard error +3.4 'GFORTRAN_STDERR_UNIT'--Unit number for standard error ========================================================== This environment variable can be used to select the unit number @@ -1802,63 +1831,63 @@ default value is 0. File: gfortran.info, Node: GFORTRAN_UNBUFFERED_ALL, Next: GFORTRAN_UNBUFFERED_PRECONNECTED, Prev: GFORTRAN_STDERR_UNIT, Up: Runtime -3.5 `GFORTRAN_UNBUFFERED_ALL'--Do not buffer I/O on all units +3.5 'GFORTRAN_UNBUFFERED_ALL'--Do not buffer I/O on all units ============================================================= This environment variable controls whether all I/O is unbuffered. If -the first letter is `y', `Y' or `1', all I/O is unbuffered. This will +the first letter is 'y', 'Y' or '1', all I/O is unbuffered. This will slow down small sequential reads and writes. If the first letter is -`n', `N' or `0', I/O is buffered. This is the default. +'n', 'N' or '0', I/O is buffered. This is the default. File: gfortran.info, Node: GFORTRAN_UNBUFFERED_PRECONNECTED, Next: GFORTRAN_SHOW_LOCUS, Prev: GFORTRAN_UNBUFFERED_ALL, Up: Runtime -3.6 `GFORTRAN_UNBUFFERED_PRECONNECTED'--Do not buffer I/O on preconnected units +3.6 'GFORTRAN_UNBUFFERED_PRECONNECTED'--Do not buffer I/O on preconnected units =============================================================================== -The environment variable named `GFORTRAN_UNBUFFERED_PRECONNECTED' +The environment variable named 'GFORTRAN_UNBUFFERED_PRECONNECTED' controls whether I/O on a preconnected unit (i.e. STDOUT or STDERR) is -unbuffered. If the first letter is `y', `Y' or `1', I/O is unbuffered. +unbuffered. If the first letter is 'y', 'Y' or '1', I/O is unbuffered. This will slow down small sequential reads and writes. If the first -letter is `n', `N' or `0', I/O is buffered. This is the default. +letter is 'n', 'N' or '0', I/O is buffered. This is the default. File: gfortran.info, Node: GFORTRAN_SHOW_LOCUS, Next: GFORTRAN_OPTIONAL_PLUS, Prev: GFORTRAN_UNBUFFERED_PRECONNECTED, Up: Runtime -3.7 `GFORTRAN_SHOW_LOCUS'--Show location for runtime errors +3.7 'GFORTRAN_SHOW_LOCUS'--Show location for runtime errors =========================================================== -If the first letter is `y', `Y' or `1', filename and line numbers for -runtime errors are printed. If the first letter is `n', `N' or `0', do +If the first letter is 'y', 'Y' or '1', filename and line numbers for +runtime errors are printed. If the first letter is 'n', 'N' or '0', do not print filename and line numbers for runtime errors. The default is to print the location. File: gfortran.info, Node: GFORTRAN_OPTIONAL_PLUS, Next: GFORTRAN_DEFAULT_RECL, Prev: GFORTRAN_SHOW_LOCUS, Up: Runtime -3.8 `GFORTRAN_OPTIONAL_PLUS'--Print leading + where permitted +3.8 'GFORTRAN_OPTIONAL_PLUS'--Print leading + where permitted ============================================================= -If the first letter is `y', `Y' or `1', a plus sign is printed where -permitted by the Fortran standard. If the first letter is `n', `N' or -`0', a plus sign is not printed in most cases. Default is not to print +If the first letter is 'y', 'Y' or '1', a plus sign is printed where +permitted by the Fortran standard. If the first letter is 'n', 'N' or +'0', a plus sign is not printed in most cases. Default is not to print plus signs. File: gfortran.info, Node: GFORTRAN_DEFAULT_RECL, Next: GFORTRAN_LIST_SEPARATOR, Prev: GFORTRAN_OPTIONAL_PLUS, Up: Runtime -3.9 `GFORTRAN_DEFAULT_RECL'--Default record length for new files +3.9 'GFORTRAN_DEFAULT_RECL'--Default record length for new files ================================================================ -This environment variable specifies the default record length, in -bytes, for files which are opened without a `RECL' tag in the `OPEN' -statement. This must be a positive integer. The default value is -1073741824 bytes (1 GB). +This environment variable specifies the default record length, in bytes, +for files which are opened without a 'RECL' tag in the 'OPEN' statement. +This must be a positive integer. The default value is 1073741824 bytes +(1 GB). File: gfortran.info, Node: GFORTRAN_LIST_SEPARATOR, Next: GFORTRAN_CONVERT_UNIT, Prev: GFORTRAN_DEFAULT_RECL, Up: Runtime -3.10 `GFORTRAN_LIST_SEPARATOR'--Separator for list output +3.10 'GFORTRAN_LIST_SEPARATOR'--Separator for list output ========================================================= This environment variable specifies the separator when writing @@ -1866,55 +1895,50 @@ list-directed output. It may contain any number of spaces and at most one comma. If you specify this on the command line, be sure to quote spaces, as in $ GFORTRAN_LIST_SEPARATOR=' , ' ./a.out - when `a.out' is the compiled Fortran program that you want to run. + when 'a.out' is the compiled Fortran program that you want to run. Default is a single space. File: gfortran.info, Node: GFORTRAN_CONVERT_UNIT, Next: GFORTRAN_ERROR_BACKTRACE, Prev: GFORTRAN_LIST_SEPARATOR, Up: Runtime -3.11 `GFORTRAN_CONVERT_UNIT'--Set endianness for unformatted I/O +3.11 'GFORTRAN_CONVERT_UNIT'--Set endianness for unformatted I/O ================================================================ -By setting the `GFORTRAN_CONVERT_UNIT' variable, it is possible to -change the representation of data for unformatted files. The syntax -for the `GFORTRAN_CONVERT_UNIT' variable is: +By setting the 'GFORTRAN_CONVERT_UNIT' variable, it is possible to +change the representation of data for unformatted files. The syntax for +the 'GFORTRAN_CONVERT_UNIT' variable is: GFORTRAN_CONVERT_UNIT: mode | mode ';' exception | exception ; mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ; exception: mode ':' unit_list | unit_list ; unit_list: unit_spec | unit_list unit_spec ; unit_spec: INTEGER | INTEGER '-' INTEGER ; - The variable consists of an optional default mode, followed by a -list of optional exceptions, which are separated by semicolons from the + The variable consists of an optional default mode, followed by a list +of optional exceptions, which are separated by semicolons from the preceding default and each other. Each exception consists of a format -and a comma-separated list of units. Valid values for the modes are -the same as for the `CONVERT' specifier: - - `NATIVE' Use the native format. This is the default. - - `SWAP' Swap between little- and big-endian. - - `LITTLE_ENDIAN' Use the little-endian format for unformatted files. - - `BIG_ENDIAN' Use the big-endian format for unformatted files. - A missing mode for an exception is taken to mean `BIG_ENDIAN'. -Examples of values for `GFORTRAN_CONVERT_UNIT' are: - `'big_endian'' Do all unformatted I/O in big_endian mode. - - `'little_endian;native:10-20,25'' Do all unformatted I/O in +and a comma-separated list of units. Valid values for the modes are the +same as for the 'CONVERT' specifier: + + 'NATIVE' Use the native format. This is the default. + 'SWAP' Swap between little- and big-endian. + 'LITTLE_ENDIAN' Use the little-endian format for unformatted files. + 'BIG_ENDIAN' Use the big-endian format for unformatted files. + A missing mode for an exception is taken to mean 'BIG_ENDIAN'. +Examples of values for 'GFORTRAN_CONVERT_UNIT' are: + ''big_endian'' Do all unformatted I/O in big_endian mode. + ''little_endian;native:10-20,25'' Do all unformatted I/O in little_endian mode, except for units 10 to 20 and 25, which are in native format. - - `'10-20'' Units 10 to 20 are big-endian, the rest is native. + ''10-20'' Units 10 to 20 are big-endian, the rest is native. Setting the environment variables should be done on the command line -or via the `export' command for `sh'-compatible shells and via `setenv' -for `csh'-compatible shells. +or via the 'export' command for 'sh'-compatible shells and via 'setenv' +for 'csh'-compatible shells. - Example for `sh': + Example for 'sh': $ gfortran foo.f90 $ GFORTRAN_CONVERT_UNIT='big_endian;native:10-20' ./a.out - Example code for `csh': + Example code for 'csh': % gfortran foo.f90 % setenv GFORTRAN_CONVERT_UNIT 'big_endian;native:10-20' % ./a.out @@ -1923,10 +1947,10 @@ for `csh'-compatible shells. carries a significant speed overhead. If speed in this area matters to you, it is best if you use this only for data that needs to be portable. - *Note CONVERT specifier::, for an alternative way to specify the -data representation for unformatted files. *Note Runtime Options::, for + *Note CONVERT specifier::, for an alternative way to specify the data +representation for unformatted files. *Note Runtime Options::, for setting a default data representation for the whole program. The -`CONVERT' specifier overrides the `-fconvert' compile options. +'CONVERT' specifier overrides the '-fconvert' compile options. _Note that the values specified via the GFORTRAN_CONVERT_UNIT environment variable will override the CONVERT specifier in the open @@ -1936,14 +1960,14 @@ not have the source code of their program available. File: gfortran.info, Node: GFORTRAN_ERROR_BACKTRACE, Prev: GFORTRAN_CONVERT_UNIT, Up: Runtime -3.12 `GFORTRAN_ERROR_BACKTRACE'--Show backtrace on run-time errors +3.12 'GFORTRAN_ERROR_BACKTRACE'--Show backtrace on run-time errors ================================================================== -If the `GFORTRAN_ERROR_BACKTRACE' variable is set to `y', `Y' or `1' +If the 'GFORTRAN_ERROR_BACKTRACE' variable is set to 'y', 'Y' or '1' (only the first letter is relevant) then a backtrace is printed when a serious run-time error occurs. To disable the backtracing, set the -variable to `n', `N', `0'. Default is to print a backtrace unless the -`-fno-backtrace' compile option was used. +variable to 'n', 'N', '0'. Default is to print a backtrace unless the +'-fno-backtrace' compile option was used. File: gfortran.info, Node: Fortran 2003 and 2008 status, Next: Compiler Characteristics, Prev: Runtime, Up: Top @@ -1969,131 +1993,128 @@ can be found below. See also the wiki page (https://gcc.gnu.org/wiki/Fortran2003) about Fortran 2003. * Procedure pointers including procedure-pointer components with - `PASS' attribute. + 'PASS' attribute. * Procedures which are bound to a derived type (type-bound - procedures) including `PASS', `PROCEDURE' and `GENERIC', and + procedures) including 'PASS', 'PROCEDURE' and 'GENERIC', and operators bound to a type. * Abstract interfaces and type extension with the possibility to override type-bound procedures or to have deferred binding. - * Polymorphic entities ("`CLASS'") for derived types and unlimited - polymorphism ("`CLASS(*)'") - including `SAME_TYPE_AS', - `EXTENDS_TYPE_OF' and `SELECT TYPE' for scalars and arrays and + * Polymorphic entities ("'CLASS'") for derived types and unlimited + polymorphism ("'CLASS(*)'") - including 'SAME_TYPE_AS', + 'EXTENDS_TYPE_OF' and 'SELECT TYPE' for scalars and arrays and finalization. * Generic interface names, which have the same name as derived types, - are now supported. This allows one to write constructor functions. + 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. - * The `ASSOCIATE' construct. + * The 'ASSOCIATE' construct. * Interoperability with C including enumerations, * In structure constructors the components with default values may be omitted. - * Extensions to the `ALLOCATE' statement, allowing for a + * Extensions to the 'ALLOCATE' statement, allowing for a type-specification with type parameter and for allocation and - initialization from a `SOURCE=' expression; `ALLOCATE' and - `DEALLOCATE' optionally return an error message string via - `ERRMSG='. + initialization from a 'SOURCE=' expression; 'ALLOCATE' and + 'DEALLOCATE' optionally return an error message string via + 'ERRMSG='. * 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 + different). Currently, scalar deferred character length left-hand sides are correctly handled but arrays are not yet fully implemented. * Deferred-length character variables and scalar deferred-length - character components of derived types are supported. (Note that + character components of derived types are supported. (Note that array-valued compoents are not yet implemented.) - * Transferring of allocations via `MOVE_ALLOC'. + * Transferring of allocations via 'MOVE_ALLOC'. - * The `PRIVATE' and `PUBLIC' attributes may be given individually to + * The 'PRIVATE' and 'PUBLIC' attributes may be given individually to derived-type components. * In pointer assignments, the lower bound may be specified and the remapping of elements is supported. - * For pointers an `INTENT' may be specified which affect the + * For pointers an 'INTENT' may be specified which affect the association status not the value of the pointer target. - * Intrinsics `command_argument_count', `get_command', - `get_command_argument', and `get_environment_variable'. + * Intrinsics 'command_argument_count', 'get_command', + 'get_command_argument', and 'get_environment_variable'. - * Support for Unicode characters (ISO 10646) and UTF-8, including - the `SELECTED_CHAR_KIND' and `NEW_LINE' intrinsic functions. + * Support for Unicode characters (ISO 10646) and UTF-8, including the + 'SELECTED_CHAR_KIND' and 'NEW_LINE' intrinsic functions. * Support for binary, octal and hexadecimal (BOZ) constants in the - intrinsic functions `INT', `REAL', `CMPLX' and `DBLE'. + intrinsic functions 'INT', 'REAL', 'CMPLX' and 'DBLE'. * Support for namelist variables with allocatable and pointer attribute and nonconstant length type parameter. - * Array constructors using square brackets. That is, `[...]' rather - than `(/.../)'. Type-specification for array constructors like - `(/ some-type :: ... /)'. + * Array constructors using square brackets. That is, '[...]' rather + than '(/.../)'. Type-specification for array constructors like '(/ + some-type :: ... /)'. * Extensions to the specification and initialization expressions, including the support for intrinsics with real and complex arguments. - * Support for the asynchronous input/output syntax; however, the - data transfer is currently always synchronously performed. + * Support for the asynchronous input/output syntax; however, the data + transfer is currently always synchronously performed. - * `FLUSH' statement. + * 'FLUSH' statement. - * `IOMSG=' specifier for I/O statements. + * 'IOMSG=' specifier for I/O statements. - * Support for the declaration of enumeration constants via the - `ENUM' and `ENUMERATOR' statements. Interoperability with `gcc' - is guaranteed also for the case where the `-fshort-enums' command - line option is given. + * Support for the declaration of enumeration constants via the 'ENUM' + and 'ENUMERATOR' statements. Interoperability with 'gcc' is + guaranteed also for the case where the '-fshort-enums' command line + option is given. * TR 15581: - * `ALLOCATABLE' dummy arguments. + * 'ALLOCATABLE' dummy arguments. + * 'ALLOCATABLE' function results + * 'ALLOCATABLE' components of derived types - * `ALLOCATABLE' function results - - * `ALLOCATABLE' components of derived types - - * The `OPEN' statement supports the `ACCESS='STREAM'' specifier, + * The 'OPEN' statement supports the 'ACCESS='STREAM'' specifier, allowing I/O without any record structure. * Namelist input/output for internal files. * 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 `strtod' + sign should appear for positive numbers. On systems where 'strtod' honours the rounding mode, the rounding mode is also supported for input. - * The `PROTECTED' statement and attribute. + * The 'PROTECTED' statement and attribute. - * The `VALUE' statement and attribute. + * The 'VALUE' statement and attribute. - * The `VOLATILE' statement and attribute. + * The 'VOLATILE' statement and attribute. - * The `IMPORT' statement, allowing to import host-associated derived + * The 'IMPORT' statement, allowing to import host-associated derived types. - * The intrinsic modules `ISO_FORTRAN_ENVIRONMENT' is supported, - which contains parameters of the I/O units, storage sizes. - Additionally, procedures for C interoperability are available in - the `ISO_C_BINDING' module. + * The intrinsic modules 'ISO_FORTRAN_ENVIRONMENT' is supported, which + contains parameters of the I/O units, storage sizes. Additionally, + procedures for C interoperability are available in the + 'ISO_C_BINDING' module. - * `USE' statement with `INTRINSIC' and `NON_INTRINSIC' attribute; - supported intrinsic modules: `ISO_FORTRAN_ENV', `ISO_C_BINDING', - `OMP_LIB' and `OMP_LIB_KINDS', and `OPENACC'. - - * Renaming of operators in the `USE' statement. + * 'USE' statement with 'INTRINSIC' and 'NON_INTRINSIC' attribute; + supported intrinsic modules: 'ISO_FORTRAN_ENV', 'ISO_C_BINDING', + 'OMP_LIB' and 'OMP_LIB_KINDS', and 'OPENACC'. + * Renaming of operators in the 'USE' statement. File: gfortran.info, Node: Fortran 2008 status, Next: TS 29113 status, Prev: Fortran 2003 status, Up: Fortran 2003 and 2008 status @@ -2106,10 +2127,10 @@ 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 -`http://www.nag.co.uk/sc22wg5/links.html'. Fortran is developed by the +<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 +International Electrotechnical Commission (IEC). This group is known as WG5 (http://www.nag.co.uk/sc22wg5/). The GNU Fortran compiler supports several of the new features of @@ -2117,102 +2138,102 @@ Fortran 2008; the wiki (https://gcc.gnu.org/wiki/Fortran2008Status) has some information about the current Fortran 2008 implementation status. In particular, the following is implemented. - * The `-std=f2008' option and support for the file extensions `.f08' - and `.F08'. + * The '-std=f2008' option and support for the file extensions '.f08' + and '.F08'. - * The `OPEN' statement now supports the `NEWUNIT=' option, which + * The 'OPEN' statement now supports the 'NEWUNIT=' option, which returns a unique file unit, thus preventing inadvertent use of the same unit in different parts of the program. - * The `g0' format descriptor and unlimited format items. + * The 'g0' format descriptor and unlimited format items. - * The mathematical intrinsics `ASINH', `ACOSH', `ATANH', `ERF', - `ERFC', `GAMMA', `LOG_GAMMA', `BESSEL_J0', `BESSEL_J1', - `BESSEL_JN', `BESSEL_Y0', `BESSEL_Y1', `BESSEL_YN', `HYPOT', - `NORM2', and `ERFC_SCALED'. + * The mathematical intrinsics 'ASINH', 'ACOSH', 'ATANH', 'ERF', + 'ERFC', 'GAMMA', 'LOG_GAMMA', 'BESSEL_J0', 'BESSEL_J1', + 'BESSEL_JN', 'BESSEL_Y0', 'BESSEL_Y1', 'BESSEL_YN', 'HYPOT', + 'NORM2', and 'ERFC_SCALED'. - * Using complex arguments with `TAN', `SINH', `COSH', `TANH', - `ASIN', `ACOS', and `ATAN' is now possible; `ATAN'(Y,X) is now an - alias for `ATAN2'(Y,X). + * Using complex arguments with 'TAN', 'SINH', 'COSH', 'TANH', 'ASIN', + 'ACOS', and 'ATAN' is now possible; 'ATAN'(Y,X) is now an alias for + 'ATAN2'(Y,X). - * Support of the `PARITY' intrinsic functions. + * Support of the 'PARITY' intrinsic functions. - * The following bit intrinsics: `LEADZ' and `TRAILZ' for counting - the number of leading and trailing zero bits, `POPCNT' and - `POPPAR' for counting the number of one bits and returning the - parity; `BGE', `BGT', `BLE', and `BLT' for bitwise comparisons; - `DSHIFTL' and `DSHIFTR' for combined left and right shifts, - `MASKL' and `MASKR' for simple left and right justified masks, - `MERGE_BITS' for a bitwise merge using a mask, `SHIFTA', `SHIFTL' - and `SHIFTR' for shift operations, and the transformational bit - intrinsics `IALL', `IANY' and `IPARITY'. + * The following bit intrinsics: 'LEADZ' and 'TRAILZ' for counting the + number of leading and trailing zero bits, 'POPCNT' and 'POPPAR' for + counting the number of one bits and returning the parity; 'BGE', + 'BGT', 'BLE', and 'BLT' for bitwise comparisons; 'DSHIFTL' and + 'DSHIFTR' for combined left and right shifts, 'MASKL' and 'MASKR' + for simple left and right justified masks, 'MERGE_BITS' for a + bitwise merge using a mask, 'SHIFTA', 'SHIFTL' and 'SHIFTR' for + shift operations, and the transformational bit intrinsics 'IALL', + 'IANY' and 'IPARITY'. - * Support of the `EXECUTE_COMMAND_LINE' intrinsic subroutine. + * Support of the 'EXECUTE_COMMAND_LINE' intrinsic subroutine. - * Support for the `STORAGE_SIZE' intrinsic inquiry function. + * Support for the 'STORAGE_SIZE' intrinsic inquiry function. - * The `INT{8,16,32}' and `REAL{32,64,128}' kind type parameters and - the array-valued named constants `INTEGER_KINDS', `LOGICAL_KINDS', - `REAL_KINDS' and `CHARACTER_KINDS' of the intrinsic module - `ISO_FORTRAN_ENV'. + * The 'INT{8,16,32}' and 'REAL{32,64,128}' kind type parameters and + the array-valued named constants 'INTEGER_KINDS', 'LOGICAL_KINDS', + 'REAL_KINDS' and 'CHARACTER_KINDS' of the intrinsic module + 'ISO_FORTRAN_ENV'. - * The module procedures `C_SIZEOF' of the intrinsic module - `ISO_C_BINDINGS' and `COMPILER_VERSION' and `COMPILER_OPTIONS' of - `ISO_FORTRAN_ENV'. + * The module procedures 'C_SIZEOF' of the intrinsic module + 'ISO_C_BINDINGS' and 'COMPILER_VERSION' and 'COMPILER_OPTIONS' of + 'ISO_FORTRAN_ENV'. - * Coarray support for serial programs with `-fcoarray=single' flag + * Coarray support for serial programs with '-fcoarray=single' flag and experimental support for multiple images with the - `-fcoarray=lib' flag. - - * Submodules are supported. It should noted that `MODULEs' do not - produce the smod file needed by the descendent `SUBMODULEs' unless - they contain at least one `MODULE PROCEDURE' interface. The reason - for this is that `SUBMODULEs' are useless without `MODULE - PROCEDUREs'. See http://j3-fortran.org/doc/meeting/207/15-209.txt - for a discussion and a draft interpretation. Adopting this + '-fcoarray=lib' flag. + + * Submodules are supported. It should noted that 'MODULEs' do not + produce the smod file needed by the descendent 'SUBMODULEs' unless + they contain at least one 'MODULE PROCEDURE' interface. The reason + for this is that 'SUBMODULEs' are useless without '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. - * The `DO CONCURRENT' construct is supported. + * The 'DO CONCURRENT' construct is supported. - * The `BLOCK' construct is supported. + * The 'BLOCK' construct is supported. - * The `STOP' and the new `ERROR STOP' statements now support all - constant expressions. Both show the signals which were signaling + * The 'STOP' and the new 'ERROR STOP' statements now support all + constant expressions. Both show the signals which were signaling at termination. - * Support for the `CONTIGUOUS' attribute. + * Support for the 'CONTIGUOUS' attribute. - * Support for `ALLOCATE' with `MOLD'. + * Support for 'ALLOCATE' with 'MOLD'. - * Support for the `IMPURE' attribute for procedures, which allows - for `ELEMENTAL' procedures without the restrictions of `PURE'. + * Support for the 'IMPURE' attribute for procedures, which allows for + 'ELEMENTAL' procedures without the restrictions of 'PURE'. - * Null pointers (including `NULL()') and not-allocated variables can + * Null pointers (including 'NULL()') and not-allocated variables can be used as actual argument to optional non-pointer, non-allocatable dummy arguments, denoting an absent argument. - * Non-pointer variables with `TARGET' attribute can be used as - actual argument to `POINTER' dummies with `INTENT(IN)'. + * Non-pointer variables with 'TARGET' attribute can be used as actual + argument to 'POINTER' dummies with 'INTENT(IN)'. * Pointers including procedure pointers and those in a derived type (pointer components) can now be initialized by a target instead of - only by `NULL'. + only by 'NULL'. - * The `EXIT' statement (with construct-name) can be now be used to - leave not only the `DO' but also the `ASSOCIATE', `BLOCK', `IF', - `SELECT CASE' and `SELECT TYPE' constructs. + * The 'EXIT' statement (with construct-name) can be now be used to + leave not only the 'DO' but also the 'ASSOCIATE', 'BLOCK', 'IF', + 'SELECT CASE' and 'SELECT TYPE' constructs. * Internal procedures can now be used as actual argument. - * Minor features: obsolesce diagnostics for `ENTRY' with - `-std=f2008'; a line may start with a semicolon; for internal and - module procedures `END' can be used instead of `END SUBROUTINE' - and `END FUNCTION'; `SELECTED_REAL_KIND' now also takes a `RADIX' + * Minor features: obsolesce diagnostics for 'ENTRY' with + '-std=f2008'; a line may start with a semicolon; for internal and + module procedures 'END' can be used instead of 'END SUBROUTINE' and + 'END FUNCTION'; 'SELECTED_REAL_KIND' now also takes a 'RADIX' argument; intrinsic types are supported for - `TYPE'(INTRINSIC-TYPE-SPEC); multiple type-bound procedures can be - declared in a single `PROCEDURE' statement; implied-shape arrays - are supported for named constants (`PARAMETER'). + 'TYPE'(INTRINSIC-TYPE-SPEC); multiple type-bound procedures can be + declared in a single 'PROCEDURE' statement; implied-shape arrays + are supported for named constants ('PARAMETER'). File: gfortran.info, Node: TS 29113 status, Next: TS 18508 status, Prev: Fortran 2008 status, Up: Fortran 2003 and 2008 status @@ -2228,19 +2249,19 @@ following is implemented. See also *note Further Interoperability of Fortran with C::. - * The `-std=f2008ts' option. + * The '-std=f2008ts' option. - * The `OPTIONAL' attribute is allowed for dummy arguments of - `BIND(C) procedures.' + * The 'OPTIONAL' attribute is allowed for dummy arguments of 'BIND(C) + procedures.' - * The `RANK' intrinsic is supported. + * The 'RANK' intrinsic is supported. - * GNU Fortran's implementation for variables with `ASYNCHRONOUS' + * GNU Fortran's implementation for variables with 'ASYNCHRONOUS' attribute is compatible with TS 29113. - * Assumed types (`TYPE(*)'. + * Assumed types ('TYPE(*)'). - * Assumed-rank (`DIMENSION(..)'). However, the array descriptor of + * Assumed-rank ('DIMENSION(..)'). However, the array descriptor of the TS is not yet supported. @@ -2255,12 +2276,15 @@ Specification 18508 on Additional Parallel Features in Fortran: * The new atomic ADD, CAS, FETCH and ADD/OR/XOR, OR and XOR intrinsics. - * The `CO_MIN' and `CO_MAX' and `SUM' reduction intrinsics. And the - `CO_BROADCAST' and `CO_REDUCE' intrinsic, except that those do not + * The 'CO_MIN' and 'CO_MAX' and 'SUM' reduction intrinsics. And the + 'CO_BROADCAST' and 'CO_REDUCE' intrinsic, except that those do not support polymorphic types or types with allocatable, pointer or polymorphic components. - * Events (`EVENT POST', `EVENT WAIT', `EVENT_QUERY') + * Events ('EVENT POST', 'EVENT WAIT', 'EVENT_QUERY') + + * Failed images ('FAIL IMAGE', 'IMAGE_STATUS', 'FAILED_IMAGES', + 'STOPPED_IMAGES') File: gfortran.info, Node: Compiler Characteristics, Next: Extensions, Prev: Fortran 2003 and 2008 status, Up: Top @@ -2287,42 +2311,41 @@ File: gfortran.info, Node: KIND Type Parameters, Next: Internal representation 5.1 KIND Type Parameters ======================== -The `KIND' type parameters supported by GNU Fortran for the primitive +The 'KIND' type parameters supported by GNU Fortran for the primitive data types are: -`INTEGER' +'INTEGER' 1, 2, 4, 8*, 16*, default: 4** -`LOGICAL' +'LOGICAL' 1, 2, 4, 8*, 16*, default: 4** -`REAL' +'REAL' 4, 8, 10*, 16*, default: 4*** -`COMPLEX' +'COMPLEX' 4, 8, 10*, 16*, default: 4*** -`DOUBLE PRECISION' +'DOUBLE PRECISION' 4, 8, 10*, 16*, default: 8*** -`CHARACTER' +'CHARACTER' 1, 4, default: 1 - * not available on all systems -** unless `-fdefault-integer-8' is used -*** unless `-fdefault-real-8' is used (see *note Fortran Dialect +** unless '-fdefault-integer-8' is used +*** unless '-fdefault-real-8' is used (see *note Fortran Dialect Options::) -The `KIND' value matches the storage size in bytes, except for -`COMPLEX' where the storage size is twice as much (or both real and -imaginary part are a real value of the given size). It is recommended -to use the *note SELECTED_CHAR_KIND::, *note SELECTED_INT_KIND:: and -*note SELECTED_REAL_KIND:: intrinsics or the `INT8', `INT16', `INT32', -`INT64', `REAL32', `REAL64', and `REAL128' parameters of the -`ISO_FORTRAN_ENV' module instead of the concrete values. The available -kind parameters can be found in the constant arrays `CHARACTER_KINDS', -`INTEGER_KINDS', `LOGICAL_KINDS' and `REAL_KINDS' in the *note +The 'KIND' value matches the storage size in bytes, except for 'COMPLEX' +where the storage size is twice as much (or both real and imaginary part +are a real value of the given size). It is recommended to use the *note +SELECTED_CHAR_KIND::, *note SELECTED_INT_KIND:: and *note +SELECTED_REAL_KIND:: intrinsics or the 'INT8', 'INT16', 'INT32', +'INT64', 'REAL32', 'REAL64', and 'REAL128' parameters of the +'ISO_FORTRAN_ENV' module instead of the concrete values. The available +kind parameters can be found in the constant arrays 'CHARACTER_KINDS', +'INTEGER_KINDS', 'LOGICAL_KINDS' and 'REAL_KINDS' in the *note ISO_FORTRAN_ENV:: module. For C interoperability, the kind parameters of the *note ISO_C_BINDING:: module should be used. @@ -2332,14 +2355,14 @@ File: gfortran.info, Node: Internal representation of LOGICAL variables, Next: 5.2 Internal representation of LOGICAL variables ================================================ -The Fortran standard does not specify how variables of `LOGICAL' type -are represented, beyond requiring that `LOGICAL' variables of default -kind have the same storage size as default `INTEGER' and `REAL' +The Fortran standard does not specify how variables of 'LOGICAL' type +are represented, beyond requiring that 'LOGICAL' variables of default +kind have the same storage size as default 'INTEGER' and 'REAL' variables. The GNU Fortran internal representation is as follows. - A `LOGICAL(KIND=N)' variable is represented as an `INTEGER(KIND=N)' -variable, however, with only two permissible values: `1' for `.TRUE.' -and `0' for `.FALSE.'. Any other integer value results in undefined + A 'LOGICAL(KIND=N)' variable is represented as an 'INTEGER(KIND=N)' +variable, however, with only two permissible values: '1' for '.TRUE.' +and '0' for '.FALSE.'. Any other integer value results in undefined behavior. See also *note Argument passing conventions:: and *note @@ -2351,45 +2374,44 @@ File: gfortran.info, Node: Thread-safety of the runtime library, Next: Data co 5.3 Thread-safety of the runtime library ======================================== -GNU Fortran can be used in programs with multiple threads, e.g. by -using OpenMP, by calling OS thread handling functions via the -`ISO_C_BINDING' facility, or by GNU Fortran compiled library code being -called from a multi-threaded program. +GNU Fortran can be used in programs with multiple threads, e.g. by using +OpenMP, by calling OS thread handling functions via the 'ISO_C_BINDING' +facility, or by GNU Fortran compiled library code being called from a +multi-threaded program. - The GNU Fortran runtime library, (`libgfortran'), supports being + The GNU Fortran runtime library, ('libgfortran'), supports being called concurrently from multiple threads with the following exceptions. - During library initialization, the C `getenv' function is used, -which need not be thread-safe. Similarly, the `getenv' function is -used to implement the `GET_ENVIRONMENT_VARIABLE' and `GETENV' -intrinsics. It is the responsibility of the user to ensure that the -environment is not being updated concurrently when any of these actions -are taking place. + During library initialization, the C 'getenv' function is used, which +need not be thread-safe. Similarly, the 'getenv' function is used to +implement the 'GET_ENVIRONMENT_VARIABLE' and 'GETENV' intrinsics. It is +the responsibility of the user to ensure that the environment is not +being updated concurrently when any of these actions are taking place. - The `EXECUTE_COMMAND_LINE' and `SYSTEM' intrinsics are implemented -with the `system' function, which need not be thread-safe. It is the -responsibility of the user to ensure that `system' is not called + The 'EXECUTE_COMMAND_LINE' and 'SYSTEM' intrinsics are implemented +with the 'system' function, which need not be thread-safe. It is the +responsibility of the user to ensure that 'system' is not called concurrently. For platforms not supporting thread-safe POSIX functions, further -functionality might not be thread-safe. For details, please consult -the documentation for your operating system. +functionality might not be thread-safe. For details, please consult the +documentation for your operating system. The GNU Fortran runtime library uses various C library functions that -depend on the locale, such as `strtod' and `snprintf'. In order to -work correctly in locale-aware programs that set the locale using -`setlocale', the locale is reset to the default "C" locale while -executing a formatted `READ' or `WRITE' statement. On targets +depend on the locale, such as 'strtod' and 'snprintf'. In order to work +correctly in locale-aware programs that set the locale using +'setlocale', the locale is reset to the default "C" locale while +executing a formatted 'READ' or 'WRITE' statement. On targets supporting the POSIX 2008 per-thread locale functions (e.g. -`newlocale', `uselocale', `freelocale'), these are used and thus the -global locale set using `setlocale' or the per-thread locales in other +'newlocale', 'uselocale', 'freelocale'), these are used and thus the +global locale set using 'setlocale' or the per-thread locales in other threads are not affected. However, on targets lacking this functionality, the global LC_NUMERIC locale is set to "C" during the -formatted I/O. Thus, on such targets it's not safe to call `setlocale' -concurrently from another thread while a Fortran formatted I/O -operation is in progress. Also, other threads doing something -dependent on the LC_NUMERIC locale might not work correctly if a -formatted I/O operation is in progress in another thread. +formatted I/O. Thus, on such targets it's not safe to call 'setlocale' +concurrently from another thread while a Fortran formatted I/O operation +is in progress. Also, other threads doing something dependent on the +LC_NUMERIC locale might not work correctly if a formatted I/O operation +is in progress in another thread. File: gfortran.info, Node: Data consistency and durability, Next: Files opened without an explicit ACTION= specifier, Prev: Thread-safety of the runtime library, Up: Compiler Characteristics @@ -2401,12 +2423,12 @@ This section contains a brief overview of data and metadata consistency and durability issues when doing I/O. With respect to durability, GNU Fortran makes no effort to ensure -that data is committed to stable storage. If this is required, the GNU -Fortran programmer can use the intrinsic `FNUM' to retrieve the low -level file descriptor corresponding to an open Fortran unit. Then, -using e.g. the `ISO_C_BINDING' feature, one can call the underlying -system call to flush dirty data to stable storage, such as `fsync' on -POSIX, `_commit' on MingW, or `fcntl(fd, F_FULLSYNC, 0)' on Mac OS X. +that data is committed to stable storage. If this is required, the GNU +Fortran programmer can use the intrinsic 'FNUM' to retrieve the low +level file descriptor corresponding to an open Fortran unit. Then, +using e.g. the 'ISO_C_BINDING' feature, one can call the underlying +system call to flush dirty data to stable storage, such as 'fsync' on +POSIX, '_commit' on MingW, or 'fcntl(fd, F_FULLSYNC, 0)' on Mac OS X. The following example shows how to call fsync: ! Declare the interface for POSIX fsync function @@ -2436,30 +2458,29 @@ The following example shows how to call fsync: if (ret /= 0) stop "Error calling FSYNC" With respect to consistency, for regular files GNU Fortran uses -buffered I/O in order to improve performance. This buffer is flushed -automatically when full and in some other situations, e.g. when closing -a unit. It can also be explicitly flushed with the `FLUSH' statement. -Also, the buffering can be turned off with the -`GFORTRAN_UNBUFFERED_ALL' and `GFORTRAN_UNBUFFERED_PRECONNECTED' -environment variables. Special files, such as terminals and pipes, are -always unbuffered. Sometimes, however, further things may need to be -done in order to allow other processes to see data that GNU Fortran has -written, as follows. +buffered I/O in order to improve performance. This buffer is flushed +automatically when full and in some other situations, e.g. when closing +a unit. It can also be explicitly flushed with the 'FLUSH' statement. +Also, the buffering can be turned off with the 'GFORTRAN_UNBUFFERED_ALL' +and 'GFORTRAN_UNBUFFERED_PRECONNECTED' environment variables. Special +files, such as terminals and pipes, are always unbuffered. Sometimes, +however, further things may need to be done in order to allow other +processes to see data that GNU Fortran has written, as follows. The Windows platform supports a relaxed metadata consistency model, -where file metadata is written to the directory lazily. This means -that, for instance, the `dir' command can show a stale size for a file. +where file metadata is written to the directory lazily. This means +that, for instance, the 'dir' command can show a stale size for a file. One can force a directory metadata update by closing the unit, or by -calling `_commit' on the file descriptor. Note, though, that `_commit' +calling '_commit' on the file descriptor. Note, though, that '_commit' will force all dirty data to stable storage, which is often a very slow operation. The Network File System (NFS) implements a relaxed consistency model -called open-to-close consistency. Closing a file forces dirty data and +called open-to-close consistency. Closing a file forces dirty data and metadata to be flushed to the server, and opening a file forces the client to contact the server in order to revalidate cached data. -`fsync' will also force a flush of dirty data and metadata to the -server. Similar to `open' and `close', acquiring and releasing `fcntl' +'fsync' will also force a flush of dirty data and metadata to the +server. Similar to 'open' and 'close', acquiring and releasing 'fcntl' file locks, if the server supports them, will also force cache validation and flushing dirty data and metadata. @@ -2469,16 +2490,13 @@ File: gfortran.info, Node: Files opened without an explicit ACTION= specifier, 5.5 Files opened without an explicit ACTION= specifier ====================================================== -The Fortran standard says that if an `OPEN' statement is executed -without an explicit `ACTION=' specifier, the default value is processor +The Fortran standard says that if an 'OPEN' statement is executed +without an explicit 'ACTION=' specifier, the default value is processor dependent. GNU Fortran behaves as follows: - 1. Attempt to open the file with `ACTION='READWRITE'' - - 2. If that fails, try to open with `ACTION='READ'' - - 3. If that fails, try to open with `ACTION='WRITE'' - + 1. Attempt to open the file with 'ACTION='READWRITE'' + 2. If that fails, try to open with 'ACTION='READ'' + 3. If that fails, try to open with 'ACTION='WRITE'' 4. If that fails, generate an error @@ -2491,20 +2509,19 @@ This section documents the behavior of GNU Fortran for file operations on symbolic links, on systems that support them. * Results of INQUIRE statements of the "inquire by file" form will - relate to the target of the symbolic link. For example, - `INQUIRE(FILE="foo",EXIST=ex)' will set EX to .TRUE. if FOO is a - symbolic link pointing to an existing file, and .FALSE. if FOO + relate to the target of the symbolic link. For example, + 'INQUIRE(FILE="foo",EXIST=ex)' will set EX to .TRUE. if FOO is a + symbolic link pointing to an existing file, and .FALSE. if FOO points to an non-existing file ("dangling" symbolic link). - * Using the `OPEN' statement with a `STATUS="NEW"' specifier on a + * Using the 'OPEN' statement with a 'STATUS="NEW"' specifier on a symbolic link will result in an error condition, whether the symbolic link points to an existing target or is dangling. - * If a symbolic link was connected, using the `CLOSE' statement with - a `STATUS="DELETE"' specifier will cause the symbolic link itself + * If a symbolic link was connected, using the 'CLOSE' statement with + a 'STATUS="DELETE"' specifier will cause the symbolic link itself to be deleted, not its target. - File: gfortran.info, Node: Extensions, Next: Mixed-Language Programming, Prev: Compiler Characteristics, Up: Top @@ -2533,12 +2550,13 @@ GNU Fortran implements a number of extensions over standard Fortran. This chapter contains information on their syntax and meaning. There are currently two categories of GNU Fortran extensions, those that provide functionality beyond that provided by any standard, and those -that are supported by GNU Fortran purely for backward compatibility -with legacy compilers. By default, `-std=gnu' allows the compiler to -accept both types of extensions, but to warn about the use of the -latter. Specifying either `-std=f95', `-std=f2003' or `-std=f2008' -disables both types of extensions, and `-std=legacy' allows both -without warning. +that are supported by GNU Fortran purely for backward compatibility with +legacy compilers. By default, '-std=gnu' allows the compiler to accept +both types of extensions, but to warn about the use of the latter. +Specifying either '-std=f95', '-std=f2003' or '-std=f2008' disables both +types of extensions, and '-std=legacy' allows both without warning. The +special compile flag '-fdec' enables additional compatibility extensions +along with those enabled by '-std=legacy'. * Menu: @@ -2549,7 +2567,7 @@ without warning. * Commas in FORMAT specifications:: * Missing period in FORMAT specifications:: * I/O item lists:: -* `Q' exponent-letter:: +* Q exponent-letter:: * BOZ literal constants:: * Real array indices:: * Unary operators:: @@ -2563,6 +2581,17 @@ without warning. * Read/Write after EOF marker:: * STRUCTURE and RECORD:: * UNION and MAP:: +* Type variants for integer intrinsics:: +* AUTOMATIC and STATIC attributes:: +* Extended math intrinsics:: +* Form feed as whitespace:: +* TYPE as an alias for PRINT:: +* %LOC as an rvalue:: +* .XOR. operator:: +* Bitwise logical operators:: +* Extended I/O specifiers:: +* Legacy PARAMETER statements:: +* Default exponents:: File: gfortran.info, Node: Old-style kind specifications, Next: Old-style variable initialization, Up: Extensions implemented in GNU Fortran @@ -2573,17 +2602,17 @@ File: gfortran.info, Node: Old-style kind specifications, Next: Old-style vari GNU Fortran allows old-style kind specifications in declarations. These look like: TYPESPEC*size x,y,z - where `TYPESPEC' is a basic type (`INTEGER', `REAL', etc.), and -where `size' is a byte count corresponding to the storage size of a -valid kind for that type. (For `COMPLEX' variables, `size' is the -total size of the real and imaginary parts.) The statement then -declares `x', `y' and `z' to be of type `TYPESPEC' with the appropriate -kind. This is equivalent to the standard-conforming declaration +where 'TYPESPEC' is a basic type ('INTEGER', 'REAL', etc.), and where +'size' is a byte count corresponding to the storage size of a valid kind +for that type. (For 'COMPLEX' variables, 'size' is the total size of +the real and imaginary parts.) The statement then declares 'x', 'y' and +'z' to be of type 'TYPESPEC' with the appropriate kind. This is +equivalent to the standard-conforming declaration TYPESPEC(k) x,y,z - where `k' is the kind parameter suitable for the intended precision. -As kind parameters are implementation-dependent, use the `KIND', -`SELECTED_INT_KIND' and `SELECTED_REAL_KIND' intrinsics to retrieve the -correct value, for instance `REAL*8 x' can be replaced by: +where 'k' is the kind parameter suitable for the intended precision. As +kind parameters are implementation-dependent, use the 'KIND', +'SELECTED_INT_KIND' and 'SELECTED_REAL_KIND' intrinsics to retrieve the +correct value, for instance 'REAL*8 x' can be replaced by: INTEGER, PARAMETER :: dbl = KIND(1.0d0) REAL(KIND=dbl) :: x @@ -2596,12 +2625,12 @@ File: gfortran.info, Node: Old-style variable initialization, Next: Extensions GNU Fortran allows old-style initialization of variables of the form: INTEGER i/1/,j/2/ REAL x(2,2) /3*0.,1./ - The syntax for the initializers is as for the `DATA' statement, but -unlike in a `DATA' statement, an initializer only applies to the + The syntax for the initializers is as for the 'DATA' statement, but +unlike in a 'DATA' statement, an initializer only applies to the variable immediately preceding the initialization. In other words, -something like `INTEGER I,J/2,3/' is not valid. This style of +something like 'INTEGER I,J/2,3/' is not valid. This style of initialization is only allowed in declarations without double colons -(`::'); the double colons were introduced in Fortran 90, which also +('::'); the double colons were introduced in Fortran 90, which also introduced a standard syntax for initializing variables in type declarations. @@ -2616,7 +2645,7 @@ are: DATA i/1/, j/2/, x/3*0.,1./ Note that variables which are explicitly initialized in declarations -or in `DATA' statements automatically acquire the `SAVE' attribute. +or in 'DATA' statements automatically acquire the 'SAVE' attribute. File: gfortran.info, Node: Extensions to namelist, Next: X format descriptor without count field, Prev: Old-style variable initialization, Up: Extensions implemented in GNU Fortran @@ -2630,17 +2659,17 @@ types. The output from a namelist write is compatible with namelist read. The output has all names in upper case and indentation to column 1 after the namelist name. Two extensions are permitted: - Old-style use of `$' instead of `&' + Old-style use of '$' instead of '&' $MYNML X(:)%Y(2) = 1.0 2.0 3.0 CH(1:4) = "abcd" $END - It should be noted that the default terminator is `/' rather than -`&END'. + It should be noted that the default terminator is '/' rather than +'&END'. Querying of the namelist when inputting from stdin. After at least -one space, entering `?' sends to stdout the namelist name and the names +one space, entering '?' sends to stdout the namelist name and the names of the variables in the namelist: ? @@ -2650,7 +2679,7 @@ of the variables in the namelist: ch &end - Entering `=?' outputs the namelist to stdout, as if `WRITE(*,NML = + Entering '=?' outputs the namelist to stdout, as if 'WRITE(*,NML = mynml)' had been called: =? @@ -2661,10 +2690,10 @@ mynml)' had been called: CH=abcd, / To aid this dialog, when input is from stdin, errors send their -messages to stderr and execution continues, even if `IOSTAT' is set. +messages to stderr and execution continues, even if 'IOSTAT' is set. - `PRINT' namelist is permitted. This causes an error if `-std=f95' -is used. + 'PRINT' namelist is permitted. This causes an error if '-std=f95' is +used. PROGRAM test_print REAL, dimension (4) :: x = (/1.0, 2.0, 3.0, 4.0/) NAMELIST /mynml/ x @@ -2672,15 +2701,15 @@ is used. END PROGRAM test_print Expanded namelist reads are permitted. This causes an error if -`-std=f95' is used. In the following example, the first element of the +'-std=f95' is used. In the following example, the first element of the array will be given the value 0.00 and the two succeeding elements will be given the values 1.00 and 2.00. &MYNML X(1,1) = 0.00 , 1.00 , 2.00 / - When writing a namelist, if no `DELIM=' is specified, by default a -double quote is used to delimit character strings. If -std=F95, F2003, + When writing a namelist, if no 'DELIM=' is specified, by default a +double quote is used to delimit character strings. If -std=F95, F2003, or F2008, etc, the delim status is set to 'none'. Defaulting to quotes ensures that namelists with character strings can be subsequently read back in accurately. @@ -2688,12 +2717,12 @@ back in accurately. File: gfortran.info, Node: X format descriptor without count field, Next: Commas in FORMAT specifications, Prev: Extensions to namelist, Up: Extensions implemented in GNU Fortran -6.1.4 `X' format descriptor without count field +6.1.4 'X' format descriptor without count field ----------------------------------------------- -To support legacy codes, GNU Fortran permits the count field of the `X' -edit descriptor in `FORMAT' statements to be omitted. When omitted, -the count is implicitly assumed to be one. +To support legacy codes, GNU Fortran permits the count field of the 'X' +edit descriptor in 'FORMAT' statements to be omitted. When omitted, the +count is implicitly assumed to be one. PRINT 10, 2, 3 10 FORMAT (I1, X, I1) @@ -2701,12 +2730,12 @@ the count is implicitly assumed to be one. File: gfortran.info, Node: Commas in FORMAT specifications, Next: Missing period in FORMAT specifications, Prev: X format descriptor without count field, Up: Extensions implemented in GNU Fortran -6.1.5 Commas in `FORMAT' specifications +6.1.5 Commas in 'FORMAT' specifications --------------------------------------- To support legacy codes, GNU Fortran allows the comma separator to be omitted immediately before and after character string edit descriptors -in `FORMAT' statements. +in 'FORMAT' statements. PRINT 10, 2, 3 10 FORMAT ('FOO='I1' BAR='I2) @@ -2714,11 +2743,11 @@ in `FORMAT' statements. File: gfortran.info, Node: Missing period in FORMAT specifications, Next: I/O item lists, Prev: Commas in FORMAT specifications, Up: Extensions implemented in GNU Fortran -6.1.6 Missing period in `FORMAT' specifications +6.1.6 Missing period in 'FORMAT' specifications ----------------------------------------------- To support legacy codes, GNU Fortran allows missing periods in format -specifications if and only if `-std=legacy' is given on the command +specifications if and only if '-std=legacy' is given on the command line. This is considered non-conforming code and is discouraged. REAL :: value @@ -2726,74 +2755,73 @@ line. This is considered non-conforming code and is discouraged. 10 FORMAT ('F4') -File: gfortran.info, Node: I/O item lists, Next: `Q' exponent-letter, Prev: Missing period in FORMAT specifications, Up: Extensions implemented in GNU Fortran +File: gfortran.info, Node: I/O item lists, Next: Q exponent-letter, Prev: Missing period in FORMAT specifications, Up: Extensions implemented in GNU Fortran 6.1.7 I/O item lists -------------------- To support legacy codes, GNU Fortran allows the input item list of the -`READ' statement, and the output item lists of the `WRITE' and `PRINT' +'READ' statement, and the output item lists of the 'WRITE' and 'PRINT' statements, to start with a comma. -File: gfortran.info, Node: `Q' exponent-letter, Next: BOZ literal constants, Prev: I/O item lists, Up: Extensions implemented in GNU Fortran +File: gfortran.info, Node: Q exponent-letter, Next: BOZ literal constants, Prev: I/O item lists, Up: Extensions implemented in GNU Fortran -6.1.8 `Q' exponent-letter +6.1.8 'Q' exponent-letter ------------------------- GNU Fortran accepts real literal constants with an exponent-letter of -`Q', for example, `1.23Q45'. The constant is interpreted as a -`REAL(16)' entity on targets that support this type. If the target -does not support `REAL(16)' but has a `REAL(10)' type, then the -real-literal-constant will be interpreted as a `REAL(10)' entity. In -the absence of `REAL(16)' and `REAL(10)', an error will occur. +'Q', for example, '1.23Q45'. The constant is interpreted as a +'REAL(16)' entity on targets that support this type. If the target does +not support 'REAL(16)' but has a 'REAL(10)' type, then the +real-literal-constant will be interpreted as a 'REAL(10)' entity. In +the absence of 'REAL(16)' and 'REAL(10)', an error will occur. -File: gfortran.info, Node: BOZ literal constants, Next: Real array indices, Prev: `Q' exponent-letter, Up: Extensions implemented in GNU Fortran +File: gfortran.info, Node: BOZ literal constants, Next: Real array indices, Prev: Q exponent-letter, Up: Extensions implemented in GNU Fortran 6.1.9 BOZ literal constants --------------------------- -Besides decimal constants, Fortran also supports binary (`b'), octal -(`o') and hexadecimal (`z') integer constants. The syntax is: `prefix -quote digits quote', were the prefix is either `b', `o' or `z', quote -is either `'' or `"' and the digits are for binary `0' or `1', for -octal between `0' and `7', and for hexadecimal between `0' and `F'. -(Example: `b'01011101''.) +Besides decimal constants, Fortran also supports binary ('b'), octal +('o') and hexadecimal ('z') integer constants. The syntax is: 'prefix +quote digits quote', were the prefix is either 'b', 'o' or 'z', quote is +either ''' or '"' and the digits are for binary '0' or '1', for octal +between '0' and '7', and for hexadecimal between '0' and 'F'. (Example: +'b'01011101''.) Up to Fortran 95, BOZ literals were only allowed to initialize integer variables in DATA statements. Since Fortran 2003 BOZ literals -are also allowed as argument of `REAL', `DBLE', `INT' and `CMPLX'; the +are also allowed as argument of 'REAL', 'DBLE', 'INT' and 'CMPLX'; the result is the same as if the integer BOZ literal had been converted by -`TRANSFER' to, respectively, `real', `double precision', `integer' or -`complex'. As GNU Fortran extension the intrinsic procedures `FLOAT', -`DFLOAT', `COMPLEX' and `DCMPLX' are treated alike. +'TRANSFER' to, respectively, 'real', 'double precision', 'integer' or +'complex'. As GNU Fortran extension the intrinsic procedures 'FLOAT', +'DFLOAT', 'COMPLEX' and 'DCMPLX' are treated alike. - As an extension, GNU Fortran allows hexadecimal BOZ literal -constants to be specified using the `X' prefix, in addition to the -standard `Z' prefix. The BOZ literal can also be specified by adding a -suffix to the string, for example, `Z'ABC'' and `'ABC'Z' are equivalent. + As an extension, GNU Fortran allows hexadecimal BOZ literal constants +to be specified using the 'X' prefix, in addition to the standard 'Z' +prefix. The BOZ literal can also be specified by adding a suffix to the +string, for example, 'Z'ABC'' and ''ABC'Z' are equivalent. Furthermore, GNU Fortran allows using BOZ literal constants outside DATA statements and the four intrinsic functions allowed by Fortran 2003. In DATA statements, in direct assignments, where the right-hand side only contains a BOZ literal constant, and for old-style -initializers of the form `integer i /o'0173'/', the constant is -transferred as if `TRANSFER' had been used; for `COMPLEX' numbers, only -the real part is initialized unless `CMPLX' is used. In all other -cases, the BOZ literal constant is converted to an `INTEGER' value with +initializers of the form 'integer i /o'0173'/', the constant is +transferred as if 'TRANSFER' had been used; for 'COMPLEX' numbers, only +the real part is initialized unless 'CMPLX' is used. In all other +cases, the BOZ literal constant is converted to an 'INTEGER' value with the largest decimal representation. This value is then converted numerically to the type and kind of the variable in question. (For -instance, `real :: r = b'0000001' + 1' initializes `r' with `2.0'.) As +instance, 'real :: r = b'0000001' + 1' initializes 'r' with '2.0'.) As different compilers implement the extension differently, one should be careful when doing bitwise initialization of non-integer variables. - Note that initializing an `INTEGER' variable with a statement such -as `DATA i/Z'FFFFFFFF'/' will give an integer overflow error rather -than the desired result of -1 when `i' is a 32-bit integer on a system -that supports 64-bit integers. The `-fno-range-check' option can be -used as a workaround for legacy code that initializes integers in this -manner. + Note that initializing an 'INTEGER' variable with a statement such as +'DATA i/Z'FFFFFFFF'/' will give an integer overflow error rather than +the desired result of -1 when 'i' is a 32-bit integer on a system that +supports 64-bit integers. The '-fno-range-check' option can be used as +a workaround for legacy code that initializes integers in this manner. File: gfortran.info, Node: Real array indices, Next: Unary operators, Prev: BOZ literal constants, Up: Extensions implemented in GNU Fortran @@ -2801,7 +2829,7 @@ File: gfortran.info, Node: Real array indices, Next: Unary operators, Prev: B 6.1.10 Real array indices ------------------------- -As an extension, GNU Fortran allows the use of `REAL' expressions or +As an extension, GNU Fortran allows the use of 'REAL' expressions or variables as array indices. @@ -2819,25 +2847,24 @@ the need for parenthesis. File: gfortran.info, Node: Implicitly convert LOGICAL and INTEGER values, Next: Hollerith constants support, Prev: Unary operators, Up: Extensions implemented in GNU Fortran -6.1.12 Implicitly convert `LOGICAL' and `INTEGER' values +6.1.12 Implicitly convert 'LOGICAL' and 'INTEGER' values -------------------------------------------------------- As an extension for backwards compatibility with other compilers, GNU -Fortran allows the implicit conversion of `LOGICAL' values to `INTEGER' -values and vice versa. When converting from a `LOGICAL' to an -`INTEGER', `.FALSE.' is interpreted as zero, and `.TRUE.' is -interpreted as one. When converting from `INTEGER' to `LOGICAL', the -value zero is interpreted as `.FALSE.' and any nonzero value is -interpreted as `.TRUE.'. +Fortran allows the implicit conversion of 'LOGICAL' values to 'INTEGER' +values and vice versa. When converting from a 'LOGICAL' to an +'INTEGER', '.FALSE.' is interpreted as zero, and '.TRUE.' is interpreted +as one. When converting from 'INTEGER' to 'LOGICAL', the value zero is +interpreted as '.FALSE.' and any nonzero value is interpreted as +'.TRUE.'. LOGICAL :: l l = 1 - INTEGER :: i i = .TRUE. - However, there is no implicit conversion of `INTEGER' values in -`if'-statements, nor of `LOGICAL' or `INTEGER' values in I/O operations. + However, there is no implicit conversion of 'INTEGER' values in +'if'-statements, nor of 'LOGICAL' or 'INTEGER' values in I/O operations. File: gfortran.info, Node: Hollerith constants support, Next: Cray pointers, Prev: Implicitly convert LOGICAL and INTEGER values, Up: Extensions implemented in GNU Fortran @@ -2846,12 +2873,12 @@ File: gfortran.info, Node: Hollerith constants support, Next: Cray pointers, ---------------------------------- GNU Fortran supports Hollerith constants in assignments, function -arguments, and `DATA' and `ASSIGN' statements. A Hollerith constant is +arguments, and 'DATA' and 'ASSIGN' statements. A Hollerith constant is written as a string of characters preceded by an integer constant -indicating the character count, and the letter `H' or `h', and stored -in bytewise fashion in a numeric (`INTEGER', `REAL', or `complex') or -`LOGICAL' variable. The constant will be padded or truncated to fit -the size of the variable in which it is stored. +indicating the character count, and the letter 'H' or 'h', and stored in +bytewise fashion in a numeric ('INTEGER', 'REAL', or 'complex') or +'LOGICAL' variable. The constant will be padded or truncated to fit the +size of the variable in which it is stored. Examples of valid uses of Hollerith constants: complex*16 x(2) @@ -2866,12 +2893,12 @@ the size of the variable in which it is stored. In general, Hollerith constants were used to provide a rudimentary facility for handling character strings in early Fortran compilers, -prior to the introduction of `CHARACTER' variables in Fortran 77; in -those cases, the standard-compliant equivalent is to convert the -program to use proper character strings. On occasion, there may be a -case where the intent is specifically to initialize a numeric variable -with a given byte sequence. In these cases, the same result can be -obtained by using the `TRANSFER' statement, as in this example. +prior to the introduction of 'CHARACTER' variables in Fortran 77; in +those cases, the standard-compliant equivalent is to convert the program +to use proper character strings. On occasion, there may be a case where +the intent is specifically to initialize a numeric variable with a given +byte sequence. In these cases, the same result can be obtained by using +the 'TRANSFER' statement, as in this example. INTEGER(KIND=4) :: a a = TRANSFER ("abcd", a) ! equivalent to: a = 4Habcd @@ -2891,17 +2918,17 @@ variables: an integer "pointer" that holds a memory address, and a or, pointer ( <pointer1> , <pointee1> ), ( <pointer2> , <pointee2> ), ... The pointer is an integer that is intended to hold a memory address. -The pointee may be an array or scalar. A pointee can be an assumed -size array--that is, the last dimension may be left unspecified by -using a `*' in place of a value--but a pointee cannot be an assumed -shape array. No space is allocated for the pointee. +The pointee may be an array or scalar. A pointee can be an assumed size +array--that is, the last dimension may be left unspecified by using a +'*' in place of a value--but a pointee cannot be an assumed shape array. +No space is allocated for the pointee. The pointee may have its type declared before or after the pointer statement, and its array specification (if any) may be declared before, during, or after the pointer statement. The pointer may be declared as an integer prior to the pointer statement. However, some machines have -default integer sizes that are different than the size of a pointer, -and so the following code is not portable: +default integer sizes that are different than the size of a pointer, and +so the following code is not portable: integer ipt pointer (ipt, iarr) If a pointer is declared with a kind that is too small, the compiler @@ -2912,31 +2939,30 @@ explicit declaration of ipt's type is omitted, then the compiler will ensure that ipt is an integer variable large enough to hold a pointer. Pointer arithmetic is valid with Cray pointers, but it is not the -same as C pointer arithmetic. Cray pointers are just ordinary -integers, so the user is responsible for determining how many bytes to -add to a pointer in order to increment it. Consider the following -example: +same as C pointer arithmetic. Cray pointers are just ordinary integers, +so the user is responsible for determining how many bytes to add to a +pointer in order to increment it. Consider the following example: real target(10) real pointee(10) pointer (ipt, pointee) ipt = loc (target) ipt = ipt + 1 - The last statement does not set `ipt' to the address of `target(1)', -as it would in C pointer arithmetic. Adding `1' to `ipt' just adds one -byte to the address stored in `ipt'. + The last statement does not set 'ipt' to the address of 'target(1)', +as it would in C pointer arithmetic. Adding '1' to 'ipt' just adds one +byte to the address stored in 'ipt'. Any expression involving the pointee will be translated to use the value stored in the pointer as the base address. To get the address of elements, this extension provides an intrinsic -function `LOC()'. The `LOC()' function is equivalent to the `&' +function 'LOC()'. The 'LOC()' function is equivalent to the '&' operator in C, except the address is cast to an integer type: real ar(10) pointer(ipt, arpte(10)) real arpte ipt = loc(ar) ! Makes arpte is an alias for ar arpte(1) = 1.0 ! Sets ar(1) to 1.0 - The pointer can also be set by a call to the `MALLOC' intrinsic (see + The pointer can also be set by a call to the 'MALLOC' intrinsic (see *note MALLOC::). Cray pointees often are used to alias an existing variable. For @@ -2945,30 +2971,30 @@ example: integer iarr(10) pointer (ipt, iarr) ipt = loc(target) - As long as `ipt' remains unchanged, `iarr' is now an alias for -`target'. The optimizer, however, will not detect this aliasing, so it -is unsafe to use `iarr' and `target' simultaneously. Using a pointee -in any way that violates the Fortran aliasing rules or assumptions is + As long as 'ipt' remains unchanged, 'iarr' is now an alias for +'target'. The optimizer, however, will not detect this aliasing, so it +is unsafe to use 'iarr' and 'target' simultaneously. Using a pointee in +any way that violates the Fortran aliasing rules or assumptions is illegal. It is the user's responsibility to avoid doing this; the compiler works under the assumption that no such aliasing occurs. Cray pointers will work correctly when there is no aliasing (i.e., when they are used to access a dynamically allocated block of memory), and also in any routine where a pointee is used, but any variable with -which it shares storage is not used. Code that violates these rules -may not run as the user intends. This is not a bug in the optimizer; -any code that violates the aliasing rules is illegal. (Note that this -is not unique to GNU Fortran; any Fortran compiler that supports Cray +which it shares storage is not used. Code that violates these rules may +not run as the user intends. This is not a bug in the optimizer; any +code that violates the aliasing rules is illegal. (Note that this is +not unique to GNU Fortran; any Fortran compiler that supports Cray pointers will "incorrectly" optimize code with illegal aliasing.) There are a number of restrictions on the attributes that can be applied to Cray pointers and pointees. Pointees may not have the -`ALLOCATABLE', `INTENT', `OPTIONAL', `DUMMY', `TARGET', `INTRINSIC', or -`POINTER' attributes. Pointers may not have the `DIMENSION', -`POINTER', `TARGET', `ALLOCATABLE', `EXTERNAL', or `INTRINSIC' -attributes, nor may they be function results. Pointees may not occur -in more than one pointer statement. A pointee cannot be a pointer. -Pointees cannot occur in equivalence, common, or data statements. +'ALLOCATABLE', 'INTENT', 'OPTIONAL', 'DUMMY', 'TARGET', 'INTRINSIC', or +'POINTER' attributes. Pointers may not have the 'DIMENSION', 'POINTER', +'TARGET', 'ALLOCATABLE', 'EXTERNAL', or 'INTRINSIC' attributes, nor may +they be function results. Pointees may not occur in more than one +pointer statement. A pointee cannot be a pointer. Pointees cannot +occur in equivalence, common, or data statements. A Cray pointer may also point to a function or a subroutine. For example, the following excerpt is valid: @@ -2985,32 +3011,29 @@ example, the following excerpt is valid: A pointer may be modified during the course of a program, and this will change the location to which the pointee refers. However, when -pointees are passed as arguments, they are treated as ordinary -variables in the invoked function. Subsequent changes to the pointer -will not change the base address of the array that was passed. +pointees are passed as arguments, they are treated as ordinary variables +in the invoked function. Subsequent changes to the pointer will not +change the base address of the array that was passed. File: gfortran.info, Node: CONVERT specifier, Next: OpenMP, Prev: Cray pointers, Up: Extensions implemented in GNU Fortran -6.1.15 `CONVERT' specifier +6.1.15 'CONVERT' specifier -------------------------- GNU Fortran allows the conversion of unformatted data between little- and big-endian representation to facilitate moving of data between -different systems. The conversion can be indicated with the `CONVERT' -specifier on the `OPEN' statement. *Note GFORTRAN_CONVERT_UNIT::, for +different systems. The conversion can be indicated with the 'CONVERT' +specifier on the 'OPEN' statement. *Note GFORTRAN_CONVERT_UNIT::, for an alternative way of specifying the data format via an environment variable. - Valid values for `CONVERT' are: - `CONVERT='NATIVE'' Use the native format. This is the default. - - `CONVERT='SWAP'' Swap between little- and big-endian. - - `CONVERT='LITTLE_ENDIAN'' Use the little-endian representation for + Valid values for 'CONVERT' are: + 'CONVERT='NATIVE'' Use the native format. This is the default. + 'CONVERT='SWAP'' Swap between little- and big-endian. + 'CONVERT='LITTLE_ENDIAN'' Use the little-endian representation for unformatted files. - - `CONVERT='BIG_ENDIAN'' Use the big-endian representation for + 'CONVERT='BIG_ENDIAN'' Use the big-endian representation for unformatted files. Using the option could look like this: @@ -3018,14 +3041,14 @@ variable. convert='big_endian') The value of the conversion can be queried by using -`INQUIRE(CONVERT=ch)'. The values returned are `'BIG_ENDIAN'' and -`'LITTLE_ENDIAN''. +'INQUIRE(CONVERT=ch)'. The values returned are ''BIG_ENDIAN'' and +''LITTLE_ENDIAN''. - `CONVERT' works between big- and little-endian for `INTEGER' values -of all supported kinds and for `REAL' on IEEE systems of kinds 4 and 8. + 'CONVERT' works between big- and little-endian for 'INTEGER' values +of all supported kinds and for 'REAL' on IEEE systems of kinds 4 and 8. Conversion between different "extended double" types on different architectures such as m68k and x86_64, which GNU Fortran supports as -`REAL(KIND=10)' and `REAL(KIND=16)', will probably not work. +'REAL(KIND=10)' and 'REAL(KIND=16)', will probably not work. _Note that the values specified via the GFORTRAN_CONVERT_UNIT environment variable will override the CONVERT specifier in the open @@ -3050,19 +3073,19 @@ directives, library routines, and environment variables that influence run-time behavior. GNU Fortran strives to be compatible to the OpenMP Application -Program Interface v4.0 (http://openmp.org/wp/openmp-specifications/). +Program Interface v4.5 (http://openmp.org/wp/openmp-specifications/). - To enable the processing of the OpenMP directive `!$omp' in -free-form source code; the `c$omp', `*$omp' and `!$omp' directives in -fixed form; the `!$' conditional compilation sentinels in free form; -and the `c$', `*$' and `!$' sentinels in fixed form, `gfortran' needs -to be invoked with the `-fopenmp'. This also arranges for automatic -linking of the GNU Offloading and Multi Processing Runtime Library -*note libgomp: (libgomp)Top. + To enable the processing of the OpenMP directive '!$omp' in free-form +source code; the 'c$omp', '*$omp' and '!$omp' directives in fixed form; +the '!$' conditional compilation sentinels in free form; and the 'c$', +'*$' and '!$' sentinels in fixed form, 'gfortran' needs to be invoked +with the '-fopenmp'. This also arranges for automatic linking of the +GNU Offloading and Multi Processing Runtime Library *note libgomp: +(libgomp)Top. The OpenMP Fortran runtime library routines are provided both in a -form of a Fortran 90 module named `omp_lib' and in a form of a Fortran -`include' file named `omp_lib.h'. +form of a Fortran 90 module named 'omp_lib' and in a form of a Fortran +'include' file named 'omp_lib.h'. An example of a parallelized loop taken from Appendix A.1 of the OpenMP Application Program Interface v2.5: @@ -3077,17 +3100,17 @@ OpenMP Application Program Interface v2.5: END SUBROUTINE A1 Please note: - * `-fopenmp' implies `-frecursive', i.e., all local arrays will be - allocated on the stack. When porting existing code to OpenMP, - this may lead to surprising results, especially to segmentation - faults if the stacksize is limited. + * '-fopenmp' implies '-frecursive', i.e., all local arrays will be + allocated on the stack. When porting existing code to OpenMP, this + may lead to surprising results, especially to segmentation faults + if the stacksize is limited. * On glibc-based systems, OpenMP enabled applications cannot be statically linked due to limitations of the underlying pthreads-implementation. It might be possible to get a working - solution if `-Wl,--whole-archive -lpthread -Wl,--no-whole-archive' + solution if '-Wl,--whole-archive -lpthread -Wl,--no-whole-archive' is added to the command line. However, this is not supported by - `gcc' and thus not recommended. + 'gcc' and thus not recommended. File: gfortran.info, Node: OpenACC, Next: Argument list functions, Prev: OpenMP, Up: Extensions implemented in GNU Fortran @@ -3103,43 +3126,43 @@ influence run-time behavior. GNU Fortran strives to be compatible to the OpenACC Application Programming Interface v2.0 (http://www.openacc.org/). - To enable the processing of the OpenACC directive `!$acc' in -free-form source code; the `c$acc', `*$acc' and `!$acc' directives in -fixed form; the `!$' conditional compilation sentinels in free form; -and the `c$', `*$' and `!$' sentinels in fixed form, `gfortran' needs -to be invoked with the `-fopenacc'. This also arranges for automatic -linking of the GNU Offloading and Multi Processing Runtime Library -*note libgomp: (libgomp)Top. + To enable the processing of the OpenACC directive '!$acc' in +free-form source code; the 'c$acc', '*$acc' and '!$acc' directives in +fixed form; the '!$' conditional compilation sentinels in free form; and +the 'c$', '*$' and '!$' sentinels in fixed form, 'gfortran' needs to be +invoked with the '-fopenacc'. This also arranges for automatic linking +of the GNU Offloading and Multi Processing Runtime Library *note +libgomp: (libgomp)Top. The OpenACC Fortran runtime library routines are provided both in a -form of a Fortran 90 module named `openacc' and in a form of a Fortran -`include' file named `openacc_lib.h'. +form of a Fortran 90 module named 'openacc' and in a form of a Fortran +'include' file named 'openacc_lib.h'. Note that this is an experimental feature, incomplete, and subject to -change in future versions of GCC. See -`https://gcc.gnu.org/wiki/OpenACC' for more information. +change in future versions of GCC. See <https://gcc.gnu.org/wiki/OpenACC> +for more information. File: gfortran.info, Node: Argument list functions, Next: Read/Write after EOF marker, Prev: OpenACC, Up: Extensions implemented in GNU Fortran -6.1.18 Argument list functions `%VAL', `%REF' and `%LOC' +6.1.18 Argument list functions '%VAL', '%REF' and '%LOC' -------------------------------------------------------- -GNU Fortran supports argument list functions `%VAL', `%REF' and `%LOC' -statements, for backward compatibility with g77. It is recommended -that these should be used only for code that is accessing facilities -outside of GNU Fortran, such as operating system or windowing -facilities. It is best to constrain such uses to isolated portions of -a program-portions that deal specifically and exclusively with -low-level, system-dependent facilities. Such portions might well -provide a portable interface for use by the program as a whole, but are -themselves not portable, and should be thoroughly tested each time they -are rebuilt using a new compiler or version of a compiler. - - `%VAL' passes a scalar argument by value, `%REF' passes it by -reference and `%LOC' passes its memory location. Since gfortran -already passes scalar arguments by reference, `%REF' is in effect a -do-nothing. `%LOC' has the same effect as a Fortran pointer. +GNU Fortran supports argument list functions '%VAL', '%REF' and '%LOC' +statements, for backward compatibility with g77. It is recommended that +these should be used only for code that is accessing facilities outside +of GNU Fortran, such as operating system or windowing facilities. It is +best to constrain such uses to isolated portions of a program-portions +that deal specifically and exclusively with low-level, system-dependent +facilities. Such portions might well provide a portable interface for +use by the program as a whole, but are themselves not portable, and +should be thoroughly tested each time they are rebuilt using a new +compiler or version of a compiler. + + '%VAL' passes a scalar argument by value, '%REF' passes it by +reference and '%LOC' passes its memory location. Since gfortran already +passes scalar arguments by reference, '%REF' is in effect a do-nothing. +'%LOC' has the same effect as a Fortran pointer. An example of passing an argument by value to a C subroutine foo.: C @@ -3152,9 +3175,9 @@ do-nothing. `%LOC' has the same effect as a Fortran pointer. end For details refer to the g77 manual -`https://gcc.gnu.org/onlinedocs/gcc-3.4.6/g77/index.html#Top'. +<https://gcc.gnu.org/onlinedocs/gcc-3.4.6/g77/index.html#Top>. - Also, `c_by_val.f' and its partner `c_by_val.c' of the GNU Fortran + Also, 'c_by_val.f' and its partner 'c_by_val.c' of the GNU Fortran testsuite are worth a look. @@ -3163,29 +3186,30 @@ File: gfortran.info, Node: Read/Write after EOF marker, Next: STRUCTURE and RE 6.1.19 Read/Write after EOF marker ---------------------------------- -Some legacy codes rely on allowing `READ' or `WRITE' after the EOF file -marker in order to find the end of a file. GNU Fortran normally rejects -these codes with a run-time error message and suggests the user -consider `BACKSPACE' or `REWIND' to properly position the file before -the EOF marker. As an extension, the run-time error may be disabled -using -std=legacy. +Some legacy codes rely on allowing 'READ' or 'WRITE' after the EOF file +marker in order to find the end of a file. GNU Fortran normally rejects +these codes with a run-time error message and suggests the user consider +'BACKSPACE' or 'REWIND' to properly position the file before the EOF +marker. As an extension, the run-time error may be disabled using +-std=legacy. File: gfortran.info, Node: STRUCTURE and RECORD, Next: UNION and MAP, Prev: Read/Write after EOF marker, Up: Extensions implemented in GNU Fortran -6.1.20 `STRUCTURE' and `RECORD' +6.1.20 'STRUCTURE' and 'RECORD' ------------------------------- Record structures are a pre-Fortran-90 vendor extension to create -user-defined aggregate data types. GNU Fortran does not support record -structures, only Fortran 90's "derived types", which have a different -syntax. +user-defined aggregate data types. Support for record structures in GNU +Fortran can be enabled with the '-fdec-structure' compile flag. If you +have a choice, you should instead use Fortran 90's "derived types", +which have a different syntax. In many cases, record structures can easily be converted to derived -types. To convert, replace `STRUCTURE /'STRUCTURE-NAME`/' by `TYPE' -TYPE-NAME. Additionally, replace `RECORD /'STRUCTURE-NAME`/' by -`TYPE('TYPE-NAME`)'. Finally, in the component access, replace the -period (`.') by the percent sign (`%'). +types. To convert, replace 'STRUCTURE /'STRUCTURE-NAME'/' by 'TYPE' +TYPE-NAME. Additionally, replace 'RECORD /'STRUCTURE-NAME'/' by +'TYPE('TYPE-NAME')'. Finally, in the component access, replace the +period ('.') by the percent sign ('%'). Here is an example of code using the non portable record structure syntax: @@ -3243,10 +3267,10 @@ This code can easily be rewritten in the Fortran 90 syntax as following: GNU Fortran implements STRUCTURES like derived types with the following rules and exceptions: - * Structures act like derived types with the `SEQUENCE' attribute. + * Structures act like derived types with the 'SEQUENCE' attribute. Otherwise they may contain no specifiers. - * Structures may share names with other symbols. For example, the + * Structures may share names with other symbols. For example, the following is invalid for derived types, but valid for structures: structure /header/ @@ -3263,7 +3287,7 @@ rules and exceptions: The type name may be ommitted, in which case the structure type itself is anonymous, and other structures of the same type cannot - be instantiated. The following shows some examples: + be instantiated. The following shows some examples: structure /appointment/ ! nested structure definition: app_time is an array of two 'time' @@ -3287,34 +3311,34 @@ rules and exceptions: character(10) memo end structure - * Structures may contain `UNION' blocks. For more detail see the + * Structures may contain 'UNION' blocks. For more detail see the section on *note UNION and MAP::. * Structures support old-style initialization of components, like - those described in *note Old-style variable initialization::. For + those described in *note Old-style variable initialization::. For array initializers, an initializer may contain a repeat - specification of the form `<literal-integer> * - <constant-initializer>'. The value of the integer indicates the + specification of the form '<literal-integer> * + <constant-initializer>'. The value of the integer indicates the number of times to repeat the constant initializer when expanding the initializer list. -File: gfortran.info, Node: UNION and MAP, Prev: STRUCTURE and RECORD, Up: Extensions implemented in GNU Fortran +File: gfortran.info, Node: UNION and MAP, Next: Type variants for integer intrinsics, Prev: STRUCTURE and RECORD, Up: Extensions implemented in GNU Fortran -6.1.21 `UNION' and `MAP' +6.1.21 'UNION' and 'MAP' ------------------------ Unions are an old vendor extension which were commonly used with the -non-standard *note STRUCTURE and RECORD:: extensions. Use of `UNION' and -`MAP' is automatically enabled with `-fdec-structure'. +non-standard *note STRUCTURE and RECORD:: extensions. Use of 'UNION' +and 'MAP' is automatically enabled with '-fdec-structure'. - A `UNION' declaration occurs within a structure; within the -definition of each union is a number of `MAP' blocks. Each `MAP' shares + A 'UNION' declaration occurs within a structure; within the +definition of each union is a number of 'MAP' blocks. Each 'MAP' shares storage with its sibling maps (in the same union), and the size of the union is the size of the largest map within it, just as with unions in C. The major difference is that component references do not indicate -which union or map the component is in (the compiler gets to figure -that out). +which union or map the component is in (the compiler gets to figure that +out). Here is a small example: structure /myunion/ @@ -3404,6 +3428,325 @@ register: a.l === '.D' +File: gfortran.info, Node: Type variants for integer intrinsics, Next: AUTOMATIC and STATIC attributes, Prev: UNION and MAP, Up: Extensions implemented in GNU Fortran + +6.1.22 Type variants for integer intrinsics +------------------------------------------- + +Similar to the D/C prefixes to real functions to specify the +input/output types, GNU Fortran offers B/I/J/K prefixes to integer +functions for compatibility with DEC programs. The types implied by +each are: + + B - INTEGER(kind=1) + I - INTEGER(kind=2) + J - INTEGER(kind=4) + K - INTEGER(kind=8) + + GNU Fortran supports these with the flag '-fdec-intrinsic-ints'. +Intrinsics for which prefixed versions are available and in what form +are noted in *note Intrinsic Procedures::. The complete list of +supported intrinsics is here: + +Intrinsic B I J K + +--------------------------------------------------------------------------- +'*note ABS::' 'BABS' 'IIABS' 'JIABS' 'KIABS' +'*note BTEST::''BBTEST' 'BITEST' 'BJTEST' 'BKTEST' +'*note IAND::' 'BIAND' 'IIAND' 'JIAND' 'KIAND' +'*note IBCLR::''BBCLR' 'IIBCLR' 'JIBCLR' 'KIBCLR' +'*note IBITS::''BBITS' 'IIBITS' 'JIBITS' 'KIBITS' +'*note IBSET::''BBSET' 'IIBSET' 'JIBSET' 'KIBSET' +'*note IEOR::' 'BIEOR' 'IIEOR' 'JIEOR' 'KIEOR' +'*note IOR::' 'BIOR' 'IIOR' 'JIOR' 'KIOR' +'*note ISHFT::''BSHFT' 'IISHFT' 'JISHFT' 'KISHFT' +'*note ISHFTC::''BSHFTC' 'IISHFTC' 'JISHFTC' 'KISHFTC' +'*note MOD::' 'BMOD' 'IMOD' 'JMOD' 'KMOD' +'*note NOT::' 'BNOT' 'INOT' 'JNOT' 'KNOT' +'*note REAL::' '--' 'FLOATI' 'FLOATJ' 'FLOATK' + + +File: gfortran.info, Node: AUTOMATIC and STATIC attributes, Next: Extended math intrinsics, Prev: Type variants for integer intrinsics, Up: Extensions implemented in GNU Fortran + +6.1.23 'AUTOMATIC' and 'STATIC' attributes +------------------------------------------ + +With '-fdec-static' GNU Fortran supports the DEC extended attributes +'STATIC' and 'AUTOMATIC' to provide explicit specification of entity +storage. These follow the syntax of the Fortran standard 'SAVE' +attribute. + + 'STATIC' is exactly equivalent to 'SAVE', and specifies that an +entity should be allocated in static memory. As an example, 'STATIC' +local variables will retain their values across multiple calls to a +function. + + Entities marked 'AUTOMATIC' will be stack automatic whenever +possible. 'AUTOMATIC' is the default for local variables smaller than +'-fmax-stack-var-size', unless '-fno-automatic' is given. This +attribute overrides '-fno-automatic', '-fmax-stack-var-size', and +blanket 'SAVE' statements. + + Examples: + + subroutine f + integer, automatic :: i ! automatic variable + integer x, y ! static variables + save + ... + endsubroutine + subroutine f + integer a, b, c, x, y, z + static :: x + save y + automatic z, c + ! a, b, c, and z are automatic + ! x and y are static + endsubroutine + ! Compiled with -fno-automatic + subroutine f + integer a, b, c, d + automatic :: a + ! a is automatic; b, c, and d are static + endsubroutine + + +File: gfortran.info, Node: Extended math intrinsics, Next: Form feed as whitespace, Prev: AUTOMATIC and STATIC attributes, Up: Extensions implemented in GNU Fortran + +6.1.24 Extended math intrinsics +------------------------------- + +GNU Fortran supports an extended list of mathematical intrinsics with +the compile flag '-fdec-math' for compatability with legacy code. These +intrinsics are described fully in *note Intrinsic Procedures:: where it +is noted that they are extensions and should be avoided whenever +possible. + + Specifically, '-fdec-math' enables the *note COTAN:: intrinsic, and +trigonometric intrinsics which accept or produce values in degrees +instead of radians. Here is a summary of the new intrinsics: + +Radians Degrees +-------------------------------------------------------------------------- +'*note ACOS::' '*note ACOSD::'* +'*note ASIN::' '*note ASIND::'* +'*note ATAN::' '*note ATAND::'* +'*note ATAN2::' '*note ATAN2D::'* +'*note COS::' '*note COSD::'* +'*note COTAN::'* '*note COTAND::'* +'*note SIN::' '*note SIND::'* +'*note TAN::' '*note TAND::'* + + * Enabled with '-fdec-math'. + + For advanced users, it may be important to know the implementation of +these functions. They are simply wrappers around the standard radian +functions, which have more accurate builtin versions. These functions +convert their arguments (or results) to degrees (or radians) by taking +the value modulus 360 (or 2*pi) and then multiplying it by a constant +radian-to-degree (or degree-to-radian) factor, as appropriate. The +factor is computed at compile-time as 180/pi (or pi/180). + + +File: gfortran.info, Node: Form feed as whitespace, Next: TYPE as an alias for PRINT, Prev: Extended math intrinsics, Up: Extensions implemented in GNU Fortran + +6.1.25 Form feed as whitespace +------------------------------ + +Historically, legacy compilers allowed insertion of form feed characters +('\f', ASCII 0xC) at the beginning of lines for formatted output to line +printers, though the Fortran standard does not mention this. GNU +Fortran supports the interpretation of form feed characters in source as +whitespace for compatibility. + + +File: gfortran.info, Node: TYPE as an alias for PRINT, Next: %LOC as an rvalue, Prev: Form feed as whitespace, Up: Extensions implemented in GNU Fortran + +6.1.26 TYPE as an alias for PRINT +--------------------------------- + +For compatibility, GNU Fortran will interpret 'TYPE' statements as +'PRINT' statements with the flag '-fdec'. With this flag asserted, the +following two examples are equivalent: + + TYPE *, 'hello world' + + PRINT *, 'hello world' + + +File: gfortran.info, Node: %LOC as an rvalue, Next: .XOR. operator, Prev: TYPE as an alias for PRINT, Up: Extensions implemented in GNU Fortran + +6.1.27 %LOC as an rvalue +------------------------ + +Normally '%LOC' is allowed only in parameter lists. However the +intrinsic function 'LOC' does the same thing, and is usable as the +right-hand-side of assignments. For compatibility, GNU Fortran supports +the use of '%LOC' as an alias for the builtin 'LOC' with '-std=legacy'. +With this feature enabled the following two examples are equivalent: + + integer :: i, l + l = %loc(i) + call sub(l) + + integer :: i + call sub(%loc(i)) + + +File: gfortran.info, Node: .XOR. operator, Next: Bitwise logical operators, Prev: %LOC as an rvalue, Up: Extensions implemented in GNU Fortran + +6.1.28 .XOR. operator +--------------------- + +GNU Fortran supports '.XOR.' as a logical operator with '-std=legacy' +for compatibility with legacy code. '.XOR.' is equivalent to '.NEQV.'. +That is, the output is true if and only if the inputs differ. + + +File: gfortran.info, Node: Bitwise logical operators, Next: Extended I/O specifiers, Prev: .XOR. operator, Up: Extensions implemented in GNU Fortran + +6.1.29 Bitwise logical operators +-------------------------------- + +With '-fdec', GNU Fortran relaxes the type constraints on logical +operators to allow integer operands, and performs the corresponding +bitwise operation instead. This flag is for compatibility only, and +should be avoided in new code. Consider: + + INTEGER :: i, j + i = z'33' + j = z'cc' + print *, i .AND. j + + In this example, compiled with '-fdec', GNU Fortran will replace the +'.AND.' operation with a call to the intrinsic '*note IAND::' function, +yielding the bitwise-and of 'i' and 'j'. + + Note that this conversion will occur if at least one operand is of +integral type. As a result, a logical operand will be converted to an +integer when the other operand is an integer in a logical operation. In +this case, '.TRUE.' is converted to '1' and '.FALSE.' to '0'. + + Here is the mapping of logical operator to bitwise intrinsic used +with '-fdec': + +Operator Intrinsic Bitwise operation +--------------------------------------------------------------------------- +'.NOT.' '*note NOT::' complement +'.AND.' '*note IAND::' intersection +'.OR.' '*note IOR::' union +'.NEQV.' '*note IEOR::' exclusive or +'.EQV.' '*note NOT::(*note IEOR::)'complement of exclusive or + + +File: gfortran.info, Node: Extended I/O specifiers, Next: Legacy PARAMETER statements, Prev: Bitwise logical operators, Up: Extensions implemented in GNU Fortran + +6.1.30 Extended I/O specifiers +------------------------------ + +GNU Fortran supports the additional legacy I/O specifiers +'CARRIAGECONTROL', 'READONLY', and 'SHARE' with the compile flag +'-fdec', for compatibility. + +'CARRIAGECONTROL' + The 'CARRIAGECONTROL' specifier allows a user to control line + termination settings between output records for an I/O unit. The + specifier has no meaning for readonly files. When + 'CARRAIGECONTROL' is specified upon opening a unit for formatted + writing, the exact 'CARRIAGECONTROL' setting determines what + characters to write between output records. The syntax is: + + OPEN(..., CARRIAGECONTROL=cc) + + Where _cc_ is a character expression that evaluates to one of the + following values: + + ''LIST'' One line feed between records (default) + ''FORTRAN'' Legacy interpretation of the first character (see below) + ''NONE'' No separator between records + + With 'CARRIAGECONTROL='FORTRAN'', when a record is written, the + first character of the input record is not written, and instead + determines the output record separator as follows: + + Leading character Meaning Output separating + character(s) + ---------------------------------------------------------------------------- + ''+'' Overprinting Carriage return only + ''-'' New line Line feed and carriage + return + ''0'' Skip line Two line feeds and carriage + return + ''1'' New page Form feed and carriage + return + ''$'' Prompting Line feed (no carriage + return) + 'CHAR(0)' Overprinting (no None + advance) + +'READONLY' + The 'READONLY' specifier may be given upon opening a unit, and is + equivalent to specifying 'ACTION='READ'', except that the file may + not be deleted on close (i.e. 'CLOSE' with 'STATUS="DELETE"'). + The syntax is: + + OPEN(..., READONLY) + +'SHARE' + The 'SHARE' specifier allows system-level locking on a unit upon + opening it for controlled access from multiple processes/threads. + The 'SHARE' specifier has several forms: + + OPEN(..., SHARE=sh) + OPEN(..., SHARED) + OPEN(..., NOSHARED) + + Where _sh_ in the first form is a character expression that + evaluates to a value as seen in the table below. The latter two + forms are aliases for particular values of _sh_: + + Explicit form Short form Meaning + ---------------------------------------------------------------------------- + 'SHARE='DENYRW'' 'NOSHARED' Exclusive (write) lock + 'SHARE='DENYNONE'' 'SHARED' Shared (read) lock + + In general only one process may hold an exclusive (write) lock for + a given file at a time, whereas many processes may hold shared + (read) locks for the same file. + + The behavior of locking may vary with your operating system. On + POSIX systems, locking is implemented with 'fcntl'. Consult your + corresponding operating system's manual pages for further details. + Locking via 'SHARE=' is not supported on other systems. + + +File: gfortran.info, Node: Legacy PARAMETER statements, Next: Default exponents, Prev: Extended I/O specifiers, Up: Extensions implemented in GNU Fortran + +6.1.31 Legacy PARAMETER statements +---------------------------------- + +For compatibility, GNU Fortran supports legacy PARAMETER statements +without parentheses with '-std=legacy'. A warning is emitted if used +with '-std=gnu', and an error is acknowledged with a real Fortran +standard flag ('-std=f95', etc...). These statements take the following +form: + + implicit real (E) + parameter e = 2.718282 + real c + parameter c = 3.0e8 + + +File: gfortran.info, Node: Default exponents, Prev: Legacy PARAMETER statements, Up: Extensions implemented in GNU Fortran + +6.1.32 Default exponents +------------------------ + +For compatibility, GNU Fortran supports a default exponent of zero in +real constants with '-fdec'. For example, '9e' would be interpreted as +'9e0', rather than an error. + + File: gfortran.info, Node: Extensions not implemented in GNU Fortran, Prev: Extensions implemented in GNU Fortran, Up: Extensions 6.2 Extensions not implemented in GNU Fortran @@ -3415,8 +3758,8 @@ some features crucial to users in the first standards have lead to the existence of a number of important extensions to the language. While some of the most useful or popular extensions are supported by the GNU Fortran compiler, not all existing extensions are supported. This -section aims at listing these extensions and offering advice on how -best make code that uses them running with the GNU Fortran compiler. +section aims at listing these extensions and offering advice on how best +make code that uses them running with the GNU Fortran compiler. * Menu: @@ -3429,12 +3772,12 @@ best make code that uses them running with the GNU Fortran compiler. File: gfortran.info, Node: ENCODE and DECODE statements, Next: Variable FORMAT expressions, Up: Extensions not implemented in GNU Fortran -6.2.1 `ENCODE' and `DECODE' statements +6.2.1 'ENCODE' and 'DECODE' statements -------------------------------------- -GNU Fortran does not support the `ENCODE' and `DECODE' statements. -These statements are best replaced by `READ' and `WRITE' statements -involving internal files (`CHARACTER' variables and arrays), which have +GNU Fortran does not support the 'ENCODE' and 'DECODE' statements. +These statements are best replaced by 'READ' and 'WRITE' statements +involving internal files ('CHARACTER' variables and arrays), which have been part of the Fortran standard since Fortran 77. For example, replace a code fragment like @@ -3471,15 +3814,15 @@ with the following: File: gfortran.info, Node: Variable FORMAT expressions, Next: Alternate complex function syntax, Prev: ENCODE and DECODE statements, Up: Extensions not implemented in GNU Fortran -6.2.2 Variable `FORMAT' expressions +6.2.2 Variable 'FORMAT' expressions ----------------------------------- -A variable `FORMAT' expression is format statement which includes angle -brackets enclosing a Fortran expression: `FORMAT(I<N>)'. GNU Fortran +A variable 'FORMAT' expression is format statement which includes angle +brackets enclosing a Fortran expression: 'FORMAT(I<N>)'. GNU Fortran does not support this legacy extension. The effect of variable format expressions can be reproduced by using the more powerful (and standard) -combination of internal output and string formats. For example, -replace a code fragment like this: +combination of internal output and string formats. For example, replace +a code fragment like this: WRITE(6,20) INT1 20 FORMAT(I<N+1>) @@ -3510,33 +3853,33 @@ File: gfortran.info, Node: Alternate complex function syntax, Next: Volatile C 6.2.3 Alternate complex function syntax --------------------------------------- -Some Fortran compilers, including `g77', let the user declare complex -functions with the syntax `COMPLEX FUNCTION name*16()', as well as -`COMPLEX*16 FUNCTION name()'. Both are non-standard, legacy -extensions. `gfortran' accepts the latter form, which is more common, -but not the former. +Some Fortran compilers, including 'g77', let the user declare complex +functions with the syntax 'COMPLEX FUNCTION name*16()', as well as +'COMPLEX*16 FUNCTION name()'. Both are non-standard, legacy extensions. +'gfortran' accepts the latter form, which is more common, but not the +former. File: gfortran.info, Node: Volatile COMMON blocks, Next: OPEN( ... NAME=), Prev: Alternate complex function syntax, Up: Extensions not implemented in GNU Fortran -6.2.4 Volatile `COMMON' blocks +6.2.4 Volatile 'COMMON' blocks ------------------------------ -Some Fortran compilers, including `g77', let the user declare `COMMON' -with the `VOLATILE' attribute. This is invalid standard Fortran syntax -and is not supported by `gfortran'. Note that `gfortran' accepts -`VOLATILE' variables in `COMMON' blocks since revision 4.3. +Some Fortran compilers, including 'g77', let the user declare 'COMMON' +with the 'VOLATILE' attribute. This is invalid standard Fortran syntax +and is not supported by 'gfortran'. Note that 'gfortran' accepts +'VOLATILE' variables in 'COMMON' blocks since revision 4.3. File: gfortran.info, Node: OPEN( ... NAME=), Prev: Volatile COMMON blocks, Up: Extensions not implemented in GNU Fortran -6.2.5 `OPEN( ... NAME=)' +6.2.5 'OPEN( ... NAME=)' ------------------------ -Some Fortran compilers, including `g77', let the user declare `OPEN( -... NAME=)'. This is invalid standard Fortran syntax and is not -supported by `gfortran'. `OPEN( ... NAME=)' should be replaced with -`OPEN( ... FILE=)'. +Some Fortran compilers, including 'g77', let the user declare 'OPEN( ... +NAME=)'. This is invalid standard Fortran syntax and is not supported +by 'gfortran'. 'OPEN( ... NAME=)' should be replaced with 'OPEN( ... +FILE=)'. File: gfortran.info, Node: Mixed-Language Programming, Next: Coarray Programming, Prev: Extensions, Up: Top @@ -3551,10 +3894,10 @@ File: gfortran.info, Node: Mixed-Language Programming, Next: Coarray Programmi * Non-Fortran Main Program:: * Naming and argument-passing conventions:: - 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 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. File: gfortran.info, Node: Interoperability with C, Next: GNU Fortran Compiler Directives, Up: Mixed-Language Programming @@ -3571,21 +3914,21 @@ File: gfortran.info, Node: Interoperability with C, Next: GNU Fortran Compiler * Working with Pointers:: * Further Interoperability of Fortran with C:: - 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 -`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, neither C's unsigned integers nor C's functions -with variable number of arguments have an equivalent in Fortran. +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 '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, neither C's unsigned integers nor C's functions with variable +number of arguments have an equivalent in Fortran. - Note that array dimensions are reversely ordered in C and that -arrays in C always start with index 0 while in Fortran they start by -default with 1. Thus, an array declaration `A(n,m)' in Fortran matches -`A[m][n]' in C and accessing the element `A(i,j)' matches -`A[j-1][i-1]'. The element following `A(i,j)' (C: `A[j-1][i-1]'; -assuming i < n) in memory is `A(i+1,j)' (C: `A[j-1][i]'). + Note that array dimensions are reversely ordered in C and that arrays +in C always start with index 0 while in Fortran they start by default +with 1. Thus, an array declaration 'A(n,m)' in Fortran matches +'A[m][n]' in C and accessing the element 'A(i,j)' matches 'A[j-1][i-1]'. +The element following 'A(i,j)' (C: 'A[j-1][i-1]'; assuming i < n) in +memory is 'A(i+1,j)' (C: 'A[j-1][i]'). File: gfortran.info, Node: Intrinsic Types, Next: Derived Types and struct, Up: Interoperability with C @@ -3594,20 +3937,19 @@ File: gfortran.info, Node: Intrinsic Types, Next: Derived Types and struct, U --------------------- 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 `ISO_C_BINDING' intrinsic module. That module contains named +in C and Fortran, the named constants shall be used which are defined in +the '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 *note +escape sequences in C. For a list of the constants, see *note ISO_C_BINDING::. For logical types, please note that the Fortran standard only -guarantees interoperability between C99's `_Bool' and Fortran's -`C_Bool'-kind logicals and C99 defines that `true' has the value 1 and -`false' the value 0. Using any other integer value with GNU Fortran's -`LOGICAL' (with any kind parameter) gives an undefined result. -(Passing other integer values than 0 and 1 to GCC's `_Bool' is also -undefined, unless the integer is explicitly or implicitly casted to -`_Bool'.) +guarantees interoperability between C99's '_Bool' and Fortran's +'C_Bool'-kind logicals and C99 defines that 'true' has the value 1 and +'false' the value 0. Using any other integer value with GNU Fortran's +'LOGICAL' (with any kind parameter) gives an undefined result. (Passing +other integer values than 0 and 1 to GCC's '_Bool' is also undefined, +unless the integer is explicitly or implicitly casted to '_Bool'.) File: gfortran.info, Node: Derived Types and struct, Next: Interoperable Global Variables, Prev: Intrinsic Types, Up: Interoperability with C @@ -3615,8 +3957,8 @@ File: gfortran.info, Node: Derived Types and struct, Next: Interoperable Globa 7.1.2 Derived Types and struct ------------------------------ -For compatibility of derived types with `struct', one needs to use the -`BIND(C)' attribute in the type declaration. For instance, the +For compatibility of derived types with 'struct', one needs to use the +'BIND(C)' attribute in the type declaration. For instance, the following type declaration USE ISO_C_BINDING @@ -3628,7 +3970,7 @@ following type declaration CHARACTER(KIND=C_CHAR) :: str(5) END TYPE - matches the following `struct' declaration in C + matches the following 'struct' declaration in C struct { int i1, i2; @@ -3640,10 +3982,10 @@ following type declaration } myType; Derived types with the C binding attribute shall not have the -`sequence' attribute, type parameters, the `extends' attribute, nor +'sequence' attribute, type parameters, the 'extends' attribute, nor type-bound procedures. Every component must be of interoperable type -and kind and may not have the `pointer' or `allocatable' attribute. -The names of the components are irrelevant for interoperability. +and kind and may not have the 'pointer' or 'allocatable' attribute. The +names of the components are irrelevant for interoperability. As there exist no direct Fortran equivalents, neither unions nor structs with bit field or variable-length array members are @@ -3657,9 +3999,9 @@ File: gfortran.info, Node: Interoperable Global Variables, Next: Interoperable Variables can be made accessible from C using the C binding attribute, optionally together with specifying a binding name. Those variables -have to be declared in the declaration part of a `MODULE', be of -interoperable type, and have neither the `pointer' nor the -`allocatable' attribute. +have to be declared in the declaration part of a 'MODULE', be of +interoperable type, and have neither the 'pointer' nor the 'allocatable' +attribute. MODULE m USE myType_module @@ -3668,14 +4010,14 @@ interoperable type, and have neither the `pointer' nor the type(myType), bind(C) :: tp END MODULE - Here, `_MyProject_flags' is the case-sensitive name of the variable -as seen from C programs while `global_flag' is the case-insensitive -name as seen from Fortran. If no binding name is specified, as for TP, -the C binding name is the (lowercase) Fortran binding name. If a -binding name is specified, only a single variable may be after the -double colon. Note of warning: You cannot use a global variable to -access ERRNO of the C library as the C standard allows it to be a -macro. Use the `IERRNO' intrinsic (GNU extension) instead. + Here, '_MyProject_flags' is the case-sensitive name of the variable +as seen from C programs while 'global_flag' is the case-insensitive name +as seen from Fortran. If no binding name is specified, as for TP, the C +binding name is the (lowercase) Fortran binding name. If a binding name +is specified, only a single variable may be after the double colon. +Note of warning: You cannot use a global variable to access ERRNO of the +C library as the C standard allows it to be a macro. Use the 'IERRNO' +intrinsic (GNU extension) instead. File: gfortran.info, Node: Interoperable Subroutines and Functions, Next: Working with Pointers, Prev: Interoperable Global Variables, Up: Interoperability with C @@ -3683,21 +4025,21 @@ File: gfortran.info, Node: Interoperable Subroutines and Functions, Next: Work 7.1.4 Interoperable Subroutines and Functions --------------------------------------------- -Subroutines and functions have to have the `BIND(C)' attribute to be -compatible with C. The dummy argument declaration is relatively +Subroutines and functions have to have the '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 +deferred-shape (i.e. allocatable or pointer) arrays. However, those are allowed since the Technical Specification 29113, see *note Further Interoperability of Fortran with C:: - To pass a variable by value, use the `VALUE' attribute. Thus, the + To pass a variable by value, use the 'VALUE' attribute. Thus, the following C prototype - `int func(int i, int *j)' + int func(int i, int *j) matches the Fortran declaration @@ -3706,13 +4048,13 @@ following C prototype integer(c_int), VALUE :: i integer(c_int) :: j - Note that pointer arguments also frequently need the `VALUE' + Note that pointer arguments also frequently need the 'VALUE' attribute, see *note Working with Pointers::. Strings are handled quite differently in C and Fortran. In C a -string is a `NUL'-terminated array of characters while in Fortran each +string is a 'NUL'-terminated array of characters while in Fortran each string has a length associated with it and is thus not terminated (by -e.g. `NUL'). For example, if one wants to use the following C +e.g. 'NUL'). For example, if one wants to use the following C function, #include <stdio.h> @@ -3732,20 +4074,20 @@ function, end interface call print_c(C_CHAR_"Hello World"//C_NULL_CHAR) - As the example shows, one needs to ensure that the string is `NUL' -terminated. Additionally, the dummy argument STRING of `print_C' is a -length-one assumed-size array; using `character(len=*)' is not allowed. -The example above uses `c_char_"Hello World"' to ensure the string + As the example shows, one needs to ensure that the string is 'NUL' +terminated. Additionally, the dummy argument STRING of 'print_C' is a +length-one assumed-size array; using 'character(len=*)' is not allowed. +The example above uses 'c_char_"Hello World"' to ensure the string literal has the right type; typically the default character kind and -`c_char' are the same and thus `"Hello World"' is equivalent. However, +'c_char' are the same and thus '"Hello World"' is equivalent. However, the standard does not guarantee this. The use of strings is now further illustrated using the C library -function `strncpy', whose prototype is +function 'strncpy', whose prototype is char *strncpy(char *restrict s1, const char *restrict s2, size_t n); - The function `strncpy' copies at most N characters from string S2 to + The function 'strncpy' copies at most N characters from string S2 to S1 and returns S1. In the following example, we ignore the return value: @@ -3778,10 +4120,10 @@ File: gfortran.info, Node: Working with Pointers, Next: Further Interoperabili --------------------------- C pointers are represented in Fortran via the special opaque derived -type `type(c_ptr)' (with private components). Thus one needs to use +type 'type(c_ptr)' (with private components). Thus one needs to use intrinsic conversion procedures to convert from or to C pointers. - For some applications, using an assumed type (`TYPE(*)') can be an + For some applications, using an assumed type ('TYPE(*)') can be an alternative to a C pointer; see *note Further Interoperability of Fortran with C::. @@ -3798,22 +4140,21 @@ Fortran with C::. call c_f_pointer(cptr2, ps) call c_f_pointer(cptr2, pa, shape=[7]) - When converting C to Fortran arrays, the one-dimensional `SHAPE' + When converting C to Fortran arrays, the one-dimensional 'SHAPE' argument has to be passed. If a pointer is a dummy-argument of an interoperable procedure, it -usually has to be declared using the `VALUE' attribute. `void*' -matches `TYPE(C_PTR), VALUE', while `TYPE(C_PTR)' alone matches -`void**'. +usually has to be declared using the 'VALUE' attribute. 'void*' matches +'TYPE(C_PTR), VALUE', while 'TYPE(C_PTR)' alone matches 'void**'. Procedure pointers are handled analogously to pointers; the C type is -`TYPE(C_FUNPTR)' and the intrinsic conversion procedures are -`C_F_PROCPOINTER' and `C_FUNLOC'. +'TYPE(C_FUNPTR)' and the intrinsic conversion procedures are +'C_F_PROCPOINTER' and 'C_FUNLOC'. Let us consider two examples of actually passing a procedure pointer from C to Fortran and vice versa. Note that these examples are also -very similar to passing ordinary pointers between both languages. First, -consider this code in C: +very similar to passing ordinary pointers between both languages. +First, consider this code in C: /* Procedure implemented in Fortran. */ void get_values (void (*)(double)); @@ -3832,9 +4173,9 @@ consider this code in C: get_values (&print_it); } - A matching implementation for `get_values' in Fortran, that correctly + A matching implementation for 'get_values' in Fortran, that correctly receives the procedure pointer from C and is able to call it, is given -in the following `MODULE': +in the following 'MODULE': MODULE m IMPLICIT NONE @@ -3925,66 +4266,66 @@ File: gfortran.info, Node: Further Interoperability of Fortran with C, Prev: W 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 (`TYPE(*)') and assumed-rank -(`dimension') variables and allows for interoperability of +of Fortran 2003 and Fortran 2008. Besides removing some restrictions +and constraints, it adds assumed-type ('TYPE(*)') and assumed-rank +('dimension') variables and allows for interoperability of assumed-shape, assumed-rank and deferred-shape arrays, including allocatables and pointers. Note: Currently, GNU Fortran does not support the array descriptor (dope vector) as specified in the Technical Specification, but uses an -array descriptor with different fields. The Chasm Language -Interoperability Tools, `http://chasm-interop.sourceforge.net/', -provide an interface to GNU Fortran's array descriptor. +array descriptor with different fields. The Chasm Language +Interoperability Tools, <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: - * The `ASYNCHRONOUS' attribute has been clarified and extended to + * The '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. - * Many constraints have been relaxed, in particular for the `C_LOC' - and `C_F_POINTER' intrinsics. + * Many constraints have been relaxed, in particular for the 'C_LOC' + and 'C_F_POINTER' intrinsics. - * The `OPTIONAL' attribute is now allowed for dummy arguments; an - absent argument matches a `NULL' pointer. + * The 'OPTIONAL' attribute is now allowed for dummy arguments; an + absent argument matches a 'NULL' pointer. - * Assumed types (`TYPE(*)') have been added, which may only be used + * Assumed types ('TYPE(*)') have been added, which may only be used for dummy arguments. They are unlimited polymorphic but contrary - to `CLASS(*)' they do not contain any type information, similar to - C's `void *' pointers. Expressions of any type and kind can be - passed; thus, it can be used as replacement for `TYPE(C_PTR)', - avoiding the use of `C_LOC' in the caller. - - Note, however, that `TYPE(*)' only accepts scalar arguments, - unless the `DIMENSION' is explicitly specified. As `DIMENSION(*)' - only supports array (including array elements) but no scalars, it - is not a full replacement for `C_LOC'. On the other hand, - assumed-type assumed-rank dummy arguments (`TYPE(*), - DIMENSION(..)') allow for both scalars and arrays, but require - special code on the callee side to handle the array descriptor. - - * Assumed-rank arrays (`DIMENSION(..)') as dummy argument allow that + to 'CLASS(*)' they do not contain any type information, similar to + C's 'void *' pointers. Expressions of any type and kind can be + passed; thus, it can be used as replacement for 'TYPE(C_PTR)', + avoiding the use of 'C_LOC' in the caller. + + Note, however, that 'TYPE(*)' only accepts scalar arguments, unless + the 'DIMENSION' is explicitly specified. As 'DIMENSION(*)' only + supports array (including array elements) but no scalars, it is not + a full replacement for 'C_LOC'. On the other hand, assumed-type + assumed-rank dummy arguments ('TYPE(*), DIMENSION(..)') allow for + both scalars and arrays, but require special code on the callee + side to handle the array descriptor. + + * Assumed-rank arrays ('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 `C_LOC' and `C_F_POINTER' to scalars or - arrays of a specific rank. The rank can be determined using the - `RANK' intrinisic. + 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 'C_LOC' and 'C_F_POINTER' to scalars or arrays + of a specific rank. The rank can be determined using the 'RANK' + intrinisic. Currently unimplemented: * GNU Fortran always uses an array descriptor, which does not match - the one of the Technical Specification. The - `ISO_Fortran_binding.h' header file and the C functions it + the one of the Technical Specification. The + 'ISO_Fortran_binding.h' header file and the C functions it specifies are not available. * Using assumed-shape, assumed-rank and deferred-shape arrays in - `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. + '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. File: gfortran.info, Node: GNU Fortran Compiler Directives, Next: Non-Fortran Main Program, Prev: Interoperability with C, Up: Mixed-Language Programming @@ -3998,17 +4339,15 @@ allow the user to choose specific implementation details, compiler directives can be used to set attributes of variables and procedures which are not part of the standard. Whether a given attribute is supported and its exact effects depend on both the operating system and -on the processor; see *note C Extensions: (gcc)Top. for details. +on the processor; see *note C Extensions: (gcc)Top. for details. For procedures and procedure pointers, the following attributes can be used to change the calling convention: - * `CDECL' - standard C calling convention - - * `STDCALL' - convention where the called procedure pops the stack - - * `FASTCALL' - part of the arguments are passed via registers - instead using the stack + * 'CDECL' - standard C calling convention + * 'STDCALL' - convention where the called procedure pops the stack + * 'FASTCALL' - part of the arguments are passed via registers instead + using the stack Besides changing the calling convention, the attributes also influence the decoration of the symbol name, e.g., by a leading @@ -4017,39 +4356,38 @@ the stack. When assigning a procedure to a procedure pointer, both should use the same calling convention. On some systems, procedures and global variables (module variables -and `COMMON' blocks) need special handling to be accessible when they +and 'COMMON' blocks) need special handling to be accessible when they are in a shared library. The following attributes are available: - * `DLLEXPORT' - provide a global pointer to a pointer in the DLL - - * `DLLIMPORT' - reference the function or variable using a global + * 'DLLEXPORT' - provide a global pointer to a pointer in the DLL + * 'DLLIMPORT' - reference the function or variable using a global pointer - For dummy arguments, the `NO_ARG_CHECK' attribute can be used; in -other compilers, it is also known as `IGNORE_TKR'. For dummy arguments + For dummy arguments, the 'NO_ARG_CHECK' attribute can be used; in +other compilers, it is also known as 'IGNORE_TKR'. For dummy arguments with this attribute actual arguments of any type and kind (similar to -`TYPE(*)'), scalars and arrays of any rank (no equivalent in Fortran -standard) are accepted. As with `TYPE(*)', the argument is unlimited +'TYPE(*)'), scalars and arrays of any rank (no equivalent in Fortran +standard) are accepted. As with 'TYPE(*)', the argument is unlimited polymorphic and no type information is available. Additionally, the -argument may only be passed to dummy arguments with the `NO_ARG_CHECK' -attribute and as argument to the `PRESENT' intrinsic function and to -`C_LOC' of the `ISO_C_BINDING' module. +argument may only be passed to dummy arguments with the 'NO_ARG_CHECK' +attribute and as argument to the 'PRESENT' intrinsic function and to +'C_LOC' of the 'ISO_C_BINDING' module. - Variables with `NO_ARG_CHECK' attribute shall be of assumed-type -(`TYPE(*)'; recommended) or of type `INTEGER', `LOGICAL', `REAL' or -`COMPLEX'. They shall not have the `ALLOCATE', `CODIMENSION', -`INTENT(OUT)', `POINTER' or `VALUE' attribute; furthermore, they shall -be either scalar or of assumed-size (`dimension(*)'). As `TYPE(*)', the -`NO_ARG_CHECK' attribute requires an explicit interface. + Variables with 'NO_ARG_CHECK' attribute shall be of assumed-type +('TYPE(*)'; recommended) or of type 'INTEGER', 'LOGICAL', 'REAL' or +'COMPLEX'. They shall not have the 'ALLOCATE', 'CODIMENSION', +'INTENT(OUT)', 'POINTER' or 'VALUE' attribute; furthermore, they shall +be either scalar or of assumed-size ('dimension(*)'). As 'TYPE(*)', the +'NO_ARG_CHECK' attribute requires an explicit interface. - * `NO_ARG_CHECK' - disable the type, kind and rank checking + * 'NO_ARG_CHECK' - disable the type, kind and rank checking The attributes are specified using the syntax - `!GCC$ ATTRIBUTES' ATTRIBUTE-LIST `::' VARIABLE-LIST + '!GCC$ ATTRIBUTES' ATTRIBUTE-LIST '::' VARIABLE-LIST where in free-form source code only whitespace is allowed before -`!GCC$' and in fixed-form source code `!GCC$', `cGCC$' or `*GCC$' shall +'!GCC$' and in fixed-form source code '!GCC$', 'cGCC$' or '*GCC$' shall start in the first column. For procedures, the compiler directives shall be placed into the body @@ -4071,31 +4409,31 @@ File: gfortran.info, Node: Non-Fortran Main Program, Next: Naming and argument * _gfortran_set_fpe:: Set when a Floating Point Exception should be raised * _gfortran_set_max_subrecord_length:: Set subrecord length - Even if you are doing mixed-language programming, it is very likely -that you do not need to know or use the information in this section. -Since it is about the internal structure of GNU Fortran, it may also -change in GCC minor releases. - - When you compile a `PROGRAM' with GNU Fortran, a function with the -name `main' (in the symbol table of the object file) is generated, -which initializes the libgfortran library and then calls the actual -program which uses the name `MAIN__', for historic reasons. If you -link GNU Fortran compiled procedures to, e.g., a C or C++ program or to -a Fortran program compiled by a different compiler, the libgfortran -library is not initialized and thus a few intrinsic procedures do not -work properly, e.g. those for obtaining the command-line arguments. - - Therefore, if your `PROGRAM' is not compiled with GNU Fortran and -the GNU Fortran compiled procedures require intrinsics relying on the +Even if you are doing mixed-language programming, it is very likely that +you do not need to know or use the information in this section. Since +it is about the internal structure of GNU Fortran, it may also change in +GCC minor releases. + + When you compile a 'PROGRAM' with GNU Fortran, a function with the +name 'main' (in the symbol table of the object file) is generated, which +initializes the libgfortran library and then calls the actual program +which uses the name 'MAIN__', for historic reasons. If you link GNU +Fortran compiled procedures to, e.g., a C or C++ program or to a Fortran +program compiled by a different compiler, the libgfortran library is not +initialized and thus a few intrinsic procedures do not work properly, +e.g. those for obtaining the command-line arguments. + + Therefore, if your 'PROGRAM' is not compiled with GNU Fortran and the +GNU Fortran compiled procedures require intrinsics relying on the library initialization, you need to initialize the library yourself. -Using the default options, gfortran calls `_gfortran_set_args' and -`_gfortran_set_options'. The initialization of the former is needed if -the called procedures access the command line (and for backtracing); -the latter sets some flags based on the standard chosen or to enable +Using the default options, gfortran calls '_gfortran_set_args' and +'_gfortran_set_options'. The initialization of the former is needed if +the called procedures access the command line (and for backtracing); the +latter sets some flags based on the standard chosen or to enable backtracing. In typical programs, it is not necessary to call any initialization function. - If your `PROGRAM' is compiled with GNU Fortran, you shall not call + If your 'PROGRAM' is compiled with GNU Fortran, you shall not call any of the following functions. The libgfortran initialization functions are shown in C syntax but using C bindings they are also accessible from Fortran. @@ -4103,22 +4441,22 @@ accessible from Fortran. File: gfortran.info, Node: _gfortran_set_args, Next: _gfortran_set_options, Up: Non-Fortran Main Program -7.3.1 `_gfortran_set_args' -- Save command-line arguments +7.3.1 '_gfortran_set_args' -- Save command-line arguments --------------------------------------------------------- _Description_: - `_gfortran_set_args' saves the command-line arguments; this - initialization is required if any of the command-line intrinsics - is called. Additionally, it shall be called if backtracing is - enabled (see `_gfortran_set_options'). + '_gfortran_set_args' saves the command-line arguments; this + initialization is required if any of the command-line intrinsics is + called. Additionally, it shall be called if backtracing is enabled + (see '_gfortran_set_options'). _Syntax_: - `void _gfortran_set_args (int argc, char *argv[])' + 'void _gfortran_set_args (int argc, char *argv[])' _Arguments_: - ARGC number of command line argument strings - ARGV the command-line argument strings; argv[0] is - the pathname of the executable itself. + ARGC number of command line argument strings + ARGV the command-line argument strings; argv[0] is + the pathname of the executable itself. _Example_: int main (int argc, char *argv[]) @@ -4131,69 +4469,68 @@ _Example_: File: gfortran.info, Node: _gfortran_set_options, Next: _gfortran_set_convert, Prev: _gfortran_set_args, Up: Non-Fortran Main Program -7.3.2 `_gfortran_set_options' -- Set library option flags +7.3.2 '_gfortran_set_options' -- Set library option flags --------------------------------------------------------- _Description_: - `_gfortran_set_options' sets several flags related to the Fortran + '_gfortran_set_options' sets several flags related to the Fortran standard to be used, whether backtracing should be enabled and whether range checks should be performed. The syntax allows for - upward compatibility since the number of passed flags is - specified; for non-passed flags, the default value is used. See - also *note Code Gen Options::. Please note that not all flags are - actually used. + upward compatibility since the number of passed flags is specified; + for non-passed flags, the default value is used. See also *note + Code Gen Options::. Please note that not all flags are actually + used. _Syntax_: - `void _gfortran_set_options (int num, int options[])' + 'void _gfortran_set_options (int num, int options[])' _Arguments_: - NUM number of options passed - ARGV The list of flag values + NUM number of options passed + ARGV The list of flag values _option flag list_: - OPTION[0] Allowed standard; can give run-time errors if - e.g. an input-output edit descriptor is - invalid in a given standard. Possible values - are (bitwise or-ed) `GFC_STD_F77' (1), - `GFC_STD_F95_OBS' (2), `GFC_STD_F95_DEL' (4), - `GFC_STD_F95' (8), `GFC_STD_F2003' (16), - `GFC_STD_GNU' (32), `GFC_STD_LEGACY' (64), - `GFC_STD_F2008' (128), `GFC_STD_F2008_OBS' - (256) and GFC_STD_F2008_TS (512). Default: - `GFC_STD_F95_OBS | GFC_STD_F95_DEL | - GFC_STD_F95 | GFC_STD_F2003 | GFC_STD_F2008 | - GFC_STD_F2008_TS | GFC_STD_F2008_OBS | - GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY'. - OPTION[1] Standard-warning flag; prints a warning to - standard error. Default: `GFC_STD_F95_DEL | - GFC_STD_LEGACY'. - OPTION[2] If non zero, enable pedantic checking. - Default: off. - OPTION[3] Unused. - OPTION[4] If non zero, enable backtracing on run-time - errors. Default: off. (Default in the - compiler: on.) Note: Installs a signal - handler and requires command-line - initialization using `_gfortran_set_args'. - OPTION[5] If non zero, supports signed zeros. Default: - enabled. - OPTION[6] Enables run-time checking. Possible values - are (bitwise or-ed): GFC_RTCHECK_BOUNDS (1), - GFC_RTCHECK_ARRAY_TEMPS (2), - GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO - (16), GFC_RTCHECK_POINTER (32). Default: - disabled. - OPTION[7] Unused. - OPTION[8] Show a warning when invoking `STOP' and `ERROR - STOP' if a floating-point exception occurred. - Possible values are (bitwise or-ed) - `GFC_FPE_INVALID' (1), `GFC_FPE_DENORMAL' (2), - `GFC_FPE_ZERO' (4), `GFC_FPE_OVERFLOW' (8), - `GFC_FPE_UNDERFLOW' (16), `GFC_FPE_INEXACT' - (32). Default: None (0). (Default in the - compiler: `GFC_FPE_INVALID | GFC_FPE_DENORMAL | - GFC_FPE_ZERO | GFC_FPE_OVERFLOW | - GFC_FPE_UNDERFLOW'.) + OPTION[0] Allowed standard; can give run-time errors if + e.g. an input-output edit descriptor is invalid + in a given standard. Possible values are + (bitwise or-ed) 'GFC_STD_F77' (1), + 'GFC_STD_F95_OBS' (2), 'GFC_STD_F95_DEL' (4), + 'GFC_STD_F95' (8), 'GFC_STD_F2003' (16), + 'GFC_STD_GNU' (32), 'GFC_STD_LEGACY' (64), + 'GFC_STD_F2008' (128), 'GFC_STD_F2008_OBS' (256) + and GFC_STD_F2008_TS (512). Default: + 'GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_F95 + | GFC_STD_F2003 | GFC_STD_F2008 | + GFC_STD_F2008_TS | GFC_STD_F2008_OBS | + GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY'. + OPTION[1] Standard-warning flag; prints a warning to + standard error. Default: 'GFC_STD_F95_DEL | + GFC_STD_LEGACY'. + OPTION[2] If non zero, enable pedantic checking. Default: + off. + OPTION[3] Unused. + OPTION[4] If non zero, enable backtracing on run-time + errors. Default: off. (Default in the + compiler: on.) Note: Installs a signal handler + and requires command-line initialization using + '_gfortran_set_args'. + OPTION[5] If non zero, supports signed zeros. Default: + enabled. + OPTION[6] Enables run-time checking. Possible values are + (bitwise or-ed): GFC_RTCHECK_BOUNDS (1), + GFC_RTCHECK_ARRAY_TEMPS (2), + GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO (16), + GFC_RTCHECK_POINTER (32). Default: disabled. + OPTION[7] Unused. + OPTION[8] Show a warning when invoking 'STOP' and 'ERROR + STOP' if a floating-point exception occurred. + Possible values are (bitwise or-ed) + 'GFC_FPE_INVALID' (1), 'GFC_FPE_DENORMAL' (2), + 'GFC_FPE_ZERO' (4), 'GFC_FPE_OVERFLOW' (8), + 'GFC_FPE_UNDERFLOW' (16), 'GFC_FPE_INEXACT' + (32). Default: None (0). (Default in the + compiler: 'GFC_FPE_INVALID | GFC_FPE_DENORMAL | + GFC_FPE_ZERO | GFC_FPE_OVERFLOW | + GFC_FPE_UNDERFLOW'.) _Example_: /* Use gfortran 4.9 default options. */ @@ -4203,21 +4540,21 @@ _Example_: File: gfortran.info, Node: _gfortran_set_convert, Next: _gfortran_set_record_marker, Prev: _gfortran_set_options, Up: Non-Fortran Main Program -7.3.3 `_gfortran_set_convert' -- Set endian conversion +7.3.3 '_gfortran_set_convert' -- Set endian conversion ------------------------------------------------------ _Description_: - `_gfortran_set_convert' set the representation of data for + '_gfortran_set_convert' set the representation of data for unformatted files. _Syntax_: - `void _gfortran_set_convert (int conv)' + 'void _gfortran_set_convert (int conv)' _Arguments_: - CONV Endian conversion, possible values: - GFC_CONVERT_NATIVE (0, default), - GFC_CONVERT_SWAP (1), GFC_CONVERT_BIG (2), - GFC_CONVERT_LITTLE (3). + CONV Endian conversion, possible values: + GFC_CONVERT_NATIVE (0, default), + GFC_CONVERT_SWAP (1), GFC_CONVERT_BIG (2), + GFC_CONVERT_LITTLE (3). _Example_: int main (int argc, char *argv[]) @@ -4231,19 +4568,19 @@ _Example_: File: gfortran.info, Node: _gfortran_set_record_marker, Next: _gfortran_set_fpe, Prev: _gfortran_set_convert, Up: Non-Fortran Main Program -7.3.4 `_gfortran_set_record_marker' -- Set length of record markers +7.3.4 '_gfortran_set_record_marker' -- Set length of record markers ------------------------------------------------------------------- _Description_: - `_gfortran_set_record_marker' sets the length of record markers - for unformatted files. + '_gfortran_set_record_marker' sets the length of record markers for + unformatted files. _Syntax_: - `void _gfortran_set_record_marker (int val)' + 'void _gfortran_set_record_marker (int val)' _Arguments_: - VAL Length of the record marker; valid values are - 4 and 8. Default is 4. + VAL Length of the record marker; valid values are 4 + and 8. Default is 4. _Example_: int main (int argc, char *argv[]) @@ -4257,24 +4594,24 @@ _Example_: File: gfortran.info, Node: _gfortran_set_fpe, Next: _gfortran_set_max_subrecord_length, Prev: _gfortran_set_record_marker, Up: Non-Fortran Main Program -7.3.5 `_gfortran_set_fpe' -- Enable floating point exception traps +7.3.5 '_gfortran_set_fpe' -- Enable floating point exception traps ------------------------------------------------------------------ _Description_: - `_gfortran_set_fpe' enables floating point exception traps for the + '_gfortran_set_fpe' enables floating point exception traps for the specified exceptions. On most systems, this will result in a SIGFPE signal being sent and the program being aborted. _Syntax_: - `void _gfortran_set_fpe (int val)' + 'void _gfortran_set_fpe (int val)' _Arguments_: - OPTION[0] IEEE exceptions. Possible values are (bitwise - or-ed) zero (0, default) no trapping, - `GFC_FPE_INVALID' (1), `GFC_FPE_DENORMAL' (2), - `GFC_FPE_ZERO' (4), `GFC_FPE_OVERFLOW' (8), - `GFC_FPE_UNDERFLOW' (16), and - `GFC_FPE_INEXACT' (32). + OPTION[0] IEEE exceptions. Possible values are (bitwise + or-ed) zero (0, default) no trapping, + 'GFC_FPE_INVALID' (1), 'GFC_FPE_DENORMAL' (2), + 'GFC_FPE_ZERO' (4), 'GFC_FPE_OVERFLOW' (8), + 'GFC_FPE_UNDERFLOW' (16), and 'GFC_FPE_INEXACT' + (32). _Example_: int main (int argc, char *argv[]) @@ -4289,21 +4626,21 @@ _Example_: File: gfortran.info, Node: _gfortran_set_max_subrecord_length, Prev: _gfortran_set_fpe, Up: Non-Fortran Main Program -7.3.6 `_gfortran_set_max_subrecord_length' -- Set subrecord length +7.3.6 '_gfortran_set_max_subrecord_length' -- Set subrecord length ------------------------------------------------------------------ _Description_: - `_gfortran_set_max_subrecord_length' set the maximum length for a + '_gfortran_set_max_subrecord_length' set the maximum length for a subrecord. This option only makes sense for testing and debugging of unformatted I/O. _Syntax_: - `void _gfortran_set_max_subrecord_length (int val)' + 'void _gfortran_set_max_subrecord_length (int val)' _Arguments_: - VAL the maximum length for a subrecord; the - maximum permitted value is 2147483639, which - is also the default. + VAL the maximum length for a subrecord; the maximum + permitted value is 2147483639, which is also the + default. _Example_: int main (int argc, char *argv[]) @@ -4339,28 +4676,27 @@ File: gfortran.info, Node: Naming conventions, Next: Argument passing conventi ------------------------ According the Fortran standard, valid Fortran names consist of a letter -between `A' to `Z', `a' to `z', digits `0', `1' to `9' and underscores -(`_') with the restriction that names may only start with a letter. As -vendor extension, the dollar sign (`$') is additionally permitted with -the option `-fdollar-ok', but not as first character and only if the +between 'A' to 'Z', 'a' to 'z', digits '0', '1' to '9' and underscores +('_') with the restriction that names may only start with a letter. As +vendor extension, the dollar sign ('$') is additionally permitted with +the option '-fdollar-ok', but not as first character and only if the target system supports it. By default, the procedure name is the lower-cased Fortran name with -an appended underscore (`_'); using `-fno-underscoring' no underscore -is appended while `-fsecond-underscore' appends two underscores. -Depending on the target system and the calling convention, the -procedure might be additionally dressed; for instance, on 32bit Windows -with `stdcall', an at-sign `@' followed by an integer number is -appended. For the changing the calling convention, see *note GNU -Fortran Compiler Directives::. - - For common blocks, the same convention is used, i.e. by default an +an appended underscore ('_'); using '-fno-underscoring' no underscore is +appended while '-fsecond-underscore' appends two underscores. Depending +on the target system and the calling convention, the procedure might be +additionally dressed; for instance, on 32bit Windows with 'stdcall', an +at-sign '@' followed by an integer number is appended. For the changing +the calling convention, see *note GNU Fortran Compiler Directives::. + + For common blocks, the same convention is used, i.e. by default an underscore is appended to the lower-cased Fortran name. Blank commons -have the name `__BLNK__'. +have the name '__BLNK__'. For procedures and variables declared in the specification space of a -module, the name is formed by `__', followed by the lower-cased module -name, `_MOD_', and the lower-cased Fortran name. Note that no +module, the name is formed by '__', followed by the lower-cased module +name, '_MOD_', and the lower-cased Fortran name. Note that no underscore is appended. @@ -4369,85 +4705,81 @@ File: gfortran.info, Node: Argument passing conventions, Prev: Naming conventi 7.4.2 Argument passing conventions ---------------------------------- -Subroutines do not return a value (matching C99's `void') while +Subroutines do not return a value (matching C99's 'void') while functions either return a value as specified in the platform ABI or the result variable is passed as hidden argument to the function and no result is returned. A hidden result variable is used when the result -variable is an array or of type `CHARACTER'. +variable is an array or of type 'CHARACTER'. Arguments are passed according to the platform ABI. In particular, complex arguments might not be compatible to a struct with two real -components for the real and imaginary part. The argument passing -matches the one of C99's `_Complex'. Functions with scalar complex +components for the real and imaginary part. The argument passing +matches the one of C99's '_Complex'. Functions with scalar complex result variables return their value and do not use a by-reference -argument. Note that with the `-ff2c' option, the argument passing is -modified and no longer completely matches the platform ABI. Some other -Fortran compilers use `f2c' semantic by default; this might cause +argument. Note that with the '-ff2c' option, the argument passing is +modified and no longer completely matches the platform ABI. Some other +Fortran compilers use 'f2c' semantic by default; this might cause problems with interoperablility. - GNU Fortran passes most arguments by reference, i.e. by passing a + GNU Fortran passes most arguments by reference, i.e. by passing a pointer to the data. Note that the compiler might use a temporary variable into which the actual argument has been copied, if required semantically (copy-in/copy-out). - For arguments with `ALLOCATABLE' and `POINTER' attribute (including + For arguments with 'ALLOCATABLE' and 'POINTER' attribute (including procedure pointers), a pointer to the pointer is passed such that the pointer address can be modified in the procedure. - For dummy arguments with the `VALUE' attribute: Scalar arguments of -the type `INTEGER', `LOGICAL', `REAL' and `COMPLEX' are passed by value -according to the platform ABI. (As vendor extension and not -recommended, using `%VAL()' in the call to a procedure has the same -effect.) For `TYPE(C_PTR)' and procedure pointers, the pointer itself -is passed such that it can be modified without affecting the caller. - - For Boolean (`LOGICAL') arguments, please note that GCC expects only -the integer value 0 and 1. If a GNU Fortran `LOGICAL' variable -contains another integer value, the result is undefined. As some other -Fortran compilers use -1 for `.TRUE.', extra care has to be taken - -such as passing the value as `INTEGER'. (The same value restriction -also applies to other front ends of GCC, e.g. to GCC's C99 compiler for -`_Bool' or GCC's Ada compiler for `Boolean'.) - - For arguments of `CHARACTER' type, the character length is passed as + For dummy arguments with the 'VALUE' attribute: Scalar arguments of +the type 'INTEGER', 'LOGICAL', 'REAL' and 'COMPLEX' are passed by value +according to the platform ABI. (As vendor extension and not recommended, +using '%VAL()' in the call to a procedure has the same effect.) For +'TYPE(C_PTR)' and procedure pointers, the pointer itself is passed such +that it can be modified without affecting the caller. + + For Boolean ('LOGICAL') arguments, please note that GCC expects only +the integer value 0 and 1. If a GNU Fortran 'LOGICAL' variable contains +another integer value, the result is undefined. As some other Fortran +compilers use -1 for '.TRUE.', extra care has to be taken - such as +passing the value as 'INTEGER'. (The same value restriction also +applies to other front ends of GCC, e.g. to GCC's C99 compiler for +'_Bool' or GCC's Ada compiler for 'Boolean'.) + + For arguments of 'CHARACTER' type, the character length is passed as hidden argument. For deferred-length strings, the value is passed by reference, otherwise by value. The character length has the type -`INTEGER(kind=4)'. Note with C binding, `CHARACTER(len=1)' result +'INTEGER(kind=4)'. Note with C binding, 'CHARACTER(len=1)' result variables are returned according to the platform ABI and no hidden -length argument is used for dummy arguments; with `VALUE', those +length argument is used for dummy arguments; with 'VALUE', those variables are passed by value. - For `OPTIONAL' dummy arguments, an absent argument is denoted by a -NULL pointer, except for scalar dummy arguments of type `INTEGER', -`LOGICAL', `REAL' and `COMPLEX' which have the `VALUE' attribute. For -those, a hidden Boolean argument (`logical(kind=C_bool),value') is used + For 'OPTIONAL' dummy arguments, an absent argument is denoted by a +NULL pointer, except for scalar dummy arguments of type 'INTEGER', +'LOGICAL', 'REAL' and 'COMPLEX' which have the 'VALUE' attribute. For +those, a hidden Boolean argument ('logical(kind=C_bool),value') is used to indicate whether the argument is present. Arguments which are assumed-shape, assumed-rank or deferred-rank -arrays or, with `-fcoarray=lib', allocatable scalar coarrays use an +arrays or, with '-fcoarray=lib', allocatable scalar coarrays use an array descriptor. All other arrays pass the address of the first -element of the array. With `-fcoarray=lib', the token and the offset +element of the array. With '-fcoarray=lib', the token and the offset belonging to nonallocatable coarrays dummy arguments are passed as hidden argument along the character length hidden arguments. The token is an oparque pointer identifying the coarray and the offset is a -passed-by-value integer of kind `C_PTRDIFF_T', denoting the byte offset +passed-by-value integer of kind 'C_PTRDIFF_T', denoting the byte offset between the base address of the coarray and the passed scalar or first element of the passed array. The arguments are passed in the following order * Result variable, when the function result is passed by reference - * Character length of the function result, if it is a of type - `CHARACTER' and no C binding is used - + 'CHARACTER' and no C binding is used * The arguments in the order in which they appear in the Fortran declaration - * The the present status for optional arguments with value attribute, which are internally passed by value - * The character length and/or coarray token and offset for the first - argument which is a `CHARACTER' or a nonallocatable coarray dummy + argument which is a 'CHARACTER' or a nonallocatable coarray dummy argument, followed by the hidden arguments of the next dummy argument of such a type @@ -4472,20 +4804,23 @@ File: gfortran.info, Node: Type and enum ABI Documentation, Next: Function ABI * caf_token_t:: * caf_register_t:: +* caf_deregister_t:: +* caf_reference_t:: +* caf_team_t:: File: gfortran.info, Node: caf_token_t, Next: caf_register_t, Up: Type and enum ABI Documentation -8.1.1 `caf_token_t' +8.1.1 'caf_token_t' ------------------- -Typedef of type `void *' on the compiler side. Can be any data type on +Typedef of type 'void *' on the compiler side. Can be any data type on the library side. -File: gfortran.info, Node: caf_register_t, Prev: caf_token_t, Up: Type and enum ABI Documentation +File: gfortran.info, Node: caf_register_t, Next: caf_deregister_t, Prev: caf_token_t, Up: Type and enum ABI Documentation -8.1.2 `caf_register_t' +8.1.2 'caf_register_t' ---------------------- Indicates which kind of coarray variable should be registered. @@ -4497,10 +4832,155 @@ typedef enum caf_register_t { CAF_REGTYPE_LOCK_ALLOC, CAF_REGTYPE_CRITICAL, CAF_REGTYPE_EVENT_STATIC, - CAF_REGTYPE_EVENT_ALLOC + CAF_REGTYPE_EVENT_ALLOC, + CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY, + CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY } caf_register_t; + The values 'CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY' and +'CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY' are for allocatable components +in derived type coarrays only. The first one sets up the token without +allocating memory for allocatable component. The latter one only +allocates the memory for an allocatable component in a derived type +coarray. The token needs to be setup previously by the REGISTER_ONLY. +This allows to have allocatable components un-allocated on some images. +The status whether an allocatable component is allocated on a remote +image can be queried by '_caf_is_present' which used internally by the +'ALLOCATED' intrinsic. + + +File: gfortran.info, Node: caf_deregister_t, Next: caf_reference_t, Prev: caf_register_t, Up: Type and enum ABI Documentation + +8.1.3 'caf_deregister_t' +------------------------ + +typedef enum caf_deregister_t { + CAF_DEREGTYPE_COARRAY_DEREGISTER, + CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY +} +caf_deregister_t; + + Allows to specifiy the type of deregistration of a coarray object. +The 'CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY' flag is only allowed for +allocatable components in derived type coarrays. + + +File: gfortran.info, Node: caf_reference_t, Next: caf_team_t, Prev: caf_deregister_t, Up: Type and enum ABI Documentation + +8.1.4 'caf_reference_t' +----------------------- + +The structure used for implementing arbitrary reference chains. A +'CAF_REFERENCE_T' allows to specify a component reference or any kind of +array reference of any rank supported by gfortran. For array references +all kinds as known by the compiler/Fortran standard are supported +indicated by a 'MODE'. + +typedef enum caf_ref_type_t { + /* Reference a component of a derived type, either regular one or an + allocatable or pointer type. For regular ones idx in caf_reference_t is + set to -1. */ + CAF_REF_COMPONENT, + /* Reference an allocatable array. */ + CAF_REF_ARRAY, + /* Reference a non-allocatable/non-pointer array. I.e., the coarray object + has no array descriptor associated and the addressing is done + completely using the ref. */ + CAF_REF_STATIC_ARRAY +} caf_ref_type_t; + +typedef enum caf_array_ref_t { + /* No array ref. This terminates the array ref. */ + CAF_ARR_REF_NONE = 0, + /* Reference array elements given by a vector. Only for this mode + caf_reference_t.u.a.dim[i].v is valid. */ + CAF_ARR_REF_VECTOR, + /* A full array ref (:). */ + CAF_ARR_REF_FULL, + /* Reference a range on elements given by start, end and stride. */ + CAF_ARR_REF_RANGE, + /* Only a single item is referenced given in the start member. */ + CAF_ARR_REF_SINGLE, + /* An array ref of the kind (i:), where i is an arbitrary valid index in the + array. The index i is given in the start member. */ + CAF_ARR_REF_OPEN_END, + /* An array ref of the kind (:i), where the lower bound of the array ref + is given by the remote side. The index i is given in the end member. */ + CAF_ARR_REF_OPEN_START +} caf_array_ref_t; + +/* References to remote components of a derived type. */ +typedef struct caf_reference_t { + /* A pointer to the next ref or NULL. */ + struct caf_reference_t *next; + /* The type of the reference. */ + /* caf_ref_type_t, replaced by int to allow specification in fortran FE. */ + int type; + /* The size of an item referenced in bytes. I.e. in an array ref this is + the factor to advance the array pointer with to get to the next item. + For component refs this gives just the size of the element referenced. */ + size_t item_size; + union { + struct { + /* The offset (in bytes) of the component in the derived type. + Unused for allocatable or pointer components. */ + ptrdiff_t offset; + /* The offset (in bytes) to the caf_token associated with this + component. NULL, when not allocatable/pointer ref. */ + ptrdiff_t caf_token_offset; + } c; + struct { + /* The mode of the array ref. See CAF_ARR_REF_*. */ + /* caf_array_ref_t, replaced by unsigend char to allow specification in + fortran FE. */ + unsigned char mode[GFC_MAX_DIMENSIONS]; + /* The type of a static array. Unset for array's with descriptors. */ + int static_array_type; + /* Subscript refs (s) or vector refs (v). */ + union { + struct { + /* The start and end boundary of the ref and the stride. */ + index_type start, end, stride; + } s; + struct { + /* nvec entries of kind giving the elements to reference. */ + void *vector; + /* The number of entries in vector. */ + size_t nvec; + /* The integer kind used for the elements in vector. */ + int kind; + } v; + } dim[GFC_MAX_DIMENSIONS]; + } a; + } u; +} caf_reference_t; + + The references make up a single linked list of reference operations. +The 'NEXT' member links to the next reference or NULL to indicate the +end of the chain. Component and array refs can be arbitrarly mixed as +long as they comply to the Fortran standard. + + _NOTES_ The member 'STATIC_ARRAY_TYPE' is used only when the 'TYPE' +is 'CAF_REF_STATIC_ARRAY'. The member gives the type of the data +referenced. Because no array descriptor is available for a +descriptor-less array and type conversion still needs to take place the +type is transported here. + + At the moment 'CAF_ARR_REF_VECTOR' is not implemented in the front +end for descriptor-less arrays. The library caf_single has untested +support for it. + + +File: gfortran.info, Node: caf_team_t, Prev: caf_reference_t, Up: Type and enum ABI Documentation + +8.1.5 'caf_team_t' +------------------ + +Opaque pointer to represent a team-handle. This type is a stand-in for +the future implementation of teams. It is about to change without +further notice. + File: gfortran.info, Node: Function ABI Documentation, Prev: Type and enum ABI Documentation, Up: Coarray Programming @@ -4513,11 +4993,18 @@ File: gfortran.info, Node: Function ABI Documentation, Prev: Type and enum ABI * _gfortran_caf_finish:: Finalization function * _gfortran_caf_this_image:: Querying the image number * _gfortran_caf_num_images:: Querying the maximal number of images +* _gfortran_caf_image_status :: Query the status of an image +* _gfortran_caf_failed_images :: Get an array of the indexes of the failed images +* _gfortran_caf_stopped_images :: Get an array of the indexes of the stopped images * _gfortran_caf_register:: Registering coarrays * _gfortran_caf_deregister:: Deregistering coarrays +* _gfortran_caf_is_present:: Query whether an allocatable or pointer component in a derived type coarray is allocated * _gfortran_caf_send:: Sending data from a local image to a remote image * _gfortran_caf_get:: Getting data from a remote image * _gfortran_caf_sendget:: Sending data between remote images +* _gfortran_caf_send_by_ref:: Sending data from a local image to a remote image using enhanced references +* _gfortran_caf_get_by_ref:: Getting data from a remote image using enhanced references +* _gfortran_caf_sendget_by_ref:: Sending data between remote images using enhanced references * _gfortran_caf_lock:: Locking a lock variable * _gfortran_caf_unlock:: Unlocking a lock variable * _gfortran_caf_event_post:: Post an event @@ -4528,6 +5015,7 @@ File: gfortran.info, Node: Function ABI Documentation, Prev: Type and enum ABI * _gfortran_caf_sync_memory:: Wait for completion of segment-memory operations * _gfortran_caf_error_stop:: Error termination with exit code * _gfortran_caf_error_stop_str:: Error termination with string +* _gfortran_caf_fail_image :: Mark the image failed and end its execution * _gfortran_caf_atomic_define:: Atomic variable assignment * _gfortran_caf_atomic_ref:: Atomic variable reference * _gfortran_caf_atomic_cas:: Atomic compare and swap @@ -4541,32 +5029,31 @@ File: gfortran.info, Node: Function ABI Documentation, Prev: Type and enum ABI File: gfortran.info, Node: _gfortran_caf_init, Next: _gfortran_caf_finish, Up: Function ABI Documentation -8.2.1 `_gfortran_caf_init' -- Initialiation function +8.2.1 '_gfortran_caf_init' -- Initialiation function ---------------------------------------------------- _Description_: This function is called at startup of the program before the Fortran main program, if the latter has been compiled with - `-fcoarray=lib'. It takes as arguments the command-line arguments - of the program. It is permitted to pass to `NULL' pointers as - argument; if non-`NULL', the library is permitted to modify the + '-fcoarray=lib'. It takes as arguments the command-line arguments + of the program. It is permitted to pass two 'NULL' pointers as + argument; if non-'NULL', the library is permitted to modify the arguments. _Syntax_: - `void _gfortran_caf_init (int *argc, char ***argv)' + 'void _gfortran_caf_init (int *argc, char ***argv)' _Arguments_: - ARGC intent(inout) An integer pointer with the - number of arguments passed to the program or - `NULL'. - ARGV intent(inout) A pointer to an array of strings - with the command-line arguments or `NULL'. + ARGC intent(inout) An integer pointer with the number + of arguments passed to the program or 'NULL'. + ARGV intent(inout) A pointer to an array of strings + with the command-line arguments or 'NULL'. _NOTES_ The function is modelled after the initialization function of the Message Passing Interface (MPI) specification. Due to the way coarray registration works, it might not be the first call to the - libaray. If the main program is not written in Fortran and only a + library. If the main program is not written in Fortran and only a library uses coarrays, it can happen that this function is never called. Therefore, it is recommended that the library does not rely on the passed arguments and whether the call has been done. @@ -4574,157 +5061,266 @@ _NOTES_ File: gfortran.info, Node: _gfortran_caf_finish, Next: _gfortran_caf_this_image, Prev: _gfortran_caf_init, Up: Function ABI Documentation -8.2.2 `_gfortran_caf_finish' -- Finalization function +8.2.2 '_gfortran_caf_finish' -- Finalization function ----------------------------------------------------- _Description_: This function is called at the end of the Fortran main program, if - it has been compiled with the `-fcoarray=lib' option. + it has been compiled with the '-fcoarray=lib' option. _Syntax_: - `void _gfortran_caf_finish (void)' + 'void _gfortran_caf_finish (void)' _NOTES_ - For non-Fortran programs, it is recommended to call the function - at the end of the main program. To ensure that the shutdown is - also performed for programs where this function is not explicitly - invoked, for instance non-Fortran programs or calls to the - system's exit() function, the library can use a destructor - function. Note that programs can also be terminated using the - STOP and ERROR STOP statements; those use different library calls. + For non-Fortran programs, it is recommended to call the function at + the end of the main program. To ensure that the shutdown is also + performed for programs where this function is not explicitly + invoked, for instance non-Fortran programs or calls to the system's + exit() function, the library can use a destructor function. Note + that programs can also be terminated using the STOP and ERROR STOP + statements; those use different library calls. File: gfortran.info, Node: _gfortran_caf_this_image, Next: _gfortran_caf_num_images, Prev: _gfortran_caf_finish, Up: Function ABI Documentation -8.2.3 `_gfortran_caf_this_image' -- Querying the image number +8.2.3 '_gfortran_caf_this_image' -- Querying the image number ------------------------------------------------------------- _Description_: - This function returns the current image number, which is a - positive number. + This function returns the current image number, which is a positive + number. _Syntax_: - `int _gfortran_caf_this_image (int distance)' + 'int _gfortran_caf_this_image (int distance)' _Arguments_: - DISTANCE As specified for the `this_image' intrinsic in - TS18508. Shall be a nonnegative number. + DISTANCE As specified for the 'this_image' intrinsic in + TS18508. Shall be a non-negative number. _NOTES_ - If the Fortran intrinsic `this_image' is invoked without an + If the Fortran intrinsic 'this_image' is invoked without an argument, which is the only permitted form in Fortran 2008, GCC - passes `0' as first argument. + passes '0' as first argument. -File: gfortran.info, Node: _gfortran_caf_num_images, Next: _gfortran_caf_register, Prev: _gfortran_caf_this_image, Up: Function ABI Documentation +File: gfortran.info, Node: _gfortran_caf_num_images, Next: _gfortran_caf_image_status, Prev: _gfortran_caf_this_image, Up: Function ABI Documentation -8.2.4 `_gfortran_caf_num_images' -- Querying the maximal number of images +8.2.4 '_gfortran_caf_num_images' -- Querying the maximal number of images ------------------------------------------------------------------------- _Description_: This function returns the number of images in the current team, if DISTANCE is 0 or the number of images in the parent team at the - specified distance. If failed is -1, the function returns the + specified distance. If failed is -1, the function returns the number of all images at the specified distance; if it is 0, the - function returns the number of nonfailed images, and if it is 1, - it returns the number of failed images. + function returns the number of nonfailed images, and if it is 1, it + returns the number of failed images. _Syntax_: - `int _gfortran_caf_num_images(int distance, int failed)' + 'int _gfortran_caf_num_images(int distance, int failed)' _Arguments_: - DISTANCE the distance from this image to the ancestor. - Shall be positive. - FAILED shall be -1, 0, or 1 + DISTANCE the distance from this image to the ancestor. + Shall be positive. + FAILED shall be -1, 0, or 1 _NOTES_ - This function follows TS18508. If the num_image intrinsic has no - arguments, the the compiler passes `distance=0' and `failed=-1' to + This function follows TS18508. If the num_image intrinsic has no + arguments, then the compiler passes 'distance=0' and 'failed=-1' to the function. -File: gfortran.info, Node: _gfortran_caf_register, Next: _gfortran_caf_deregister, Prev: _gfortran_caf_num_images, Up: Function ABI Documentation +File: gfortran.info, Node: _gfortran_caf_image_status, Next: _gfortran_caf_failed_images, Prev: _gfortran_caf_num_images, Up: Function ABI Documentation + +8.2.5 '_gfortran_caf_image_status' -- Query the status of an image +------------------------------------------------------------------ + +_Description_: + Get the status of the image given by the id IMAGE of the team given + by TEAM. Valid results are zero, for image is ok, + 'STAT_STOPPED_IMAGE' from the ISO_FORTRAN_ENV module to indicate + that the image has been stopped and 'STAT_FAILED_IMAGE' also from + ISO_FORTRAN_ENV to indicate that the image has executed a 'FAIL + IMAGE' statement. + +_Syntax_: + 'int _gfortran_caf_image_status (int image, caf_team_t * team)' + +_Arguments_: + IMAGE the positive scalar id of the image in the + current TEAM. + TEAM optional; team on the which the inquiry is to be + performed. + +_NOTES_ + This function follows TS18508. Because team-functionality is not + yet implemented a null-pointer is passed for the TEAM argument at + the moment. + + +File: gfortran.info, Node: _gfortran_caf_failed_images, Next: _gfortran_caf_stopped_images, Prev: _gfortran_caf_image_status, Up: Function ABI Documentation + +8.2.6 '_gfortran_caf_failed_images' -- Get an array of the indexes of the failed images +--------------------------------------------------------------------------------------- + +_Description_: + Get an array of image indexes in the current TEAM that have failed. + The array is sorted ascendingly. When TEAM is not provided the + current team is to be used. When KIND is provided then the + resulting array is of that integer kind else it is of default + integer kind. The returns an unallocated size zero array when no + images have failed. + +_Syntax_: + 'int _gfortran_caf_failed_images (caf_team_t * team, int * kind)' + +_Arguments_: + TEAM optional; team on the which the inquiry is to be + performed. + IMAGE optional; the kind of the resulting integer + array. + +_NOTES_ + This function follows TS18508. Because team-functionality is not + yet implemented a null-pointer is passed for the TEAM argument at + the moment. + + +File: gfortran.info, Node: _gfortran_caf_stopped_images, Next: _gfortran_caf_register, Prev: _gfortran_caf_failed_images, Up: Function ABI Documentation + +8.2.7 '_gfortran_caf_stopped_images' -- Get an array of the indexes of the stopped images +----------------------------------------------------------------------------------------- + +_Description_: + Get an array of image indexes in the current TEAM that have + stopped. The array is sorted ascendingly. When TEAM is not + provided the current team is to be used. When KIND is provided + then the resulting array is of that integer kind else it is of + default integer kind. The returns an unallocated size zero array + when no images have failed. + +_Syntax_: + 'int _gfortran_caf_stopped_images (caf_team_t * team, int * kind)' + +_Arguments_: + TEAM optional; team on the which the inquiry is to be + performed. + IMAGE optional; the kind of the resulting integer + array. + +_NOTES_ + This function follows TS18508. Because team-functionality is not + yet implemented a null-pointer is passed for the TEAM argument at + the moment. + + +File: gfortran.info, Node: _gfortran_caf_register, Next: _gfortran_caf_deregister, Prev: _gfortran_caf_stopped_images, Up: Function ABI Documentation -8.2.5 `_gfortran_caf_register' -- Registering coarrays +8.2.8 '_gfortran_caf_register' -- Registering coarrays ------------------------------------------------------ _Description_: - Allocates memory for a coarray and creates a token to identify the - coarray. The function is called for both coarrays with `SAVE' - attribute and using an explicit `ALLOCATE' statement. If an error - occurs and STAT is a `NULL' pointer, the function shall abort with + Registers memory for a coarray and creates a token to identify the + coarray. The routine is called for both coarrays with 'SAVE' + attribute and using an explicit 'ALLOCATE' statement. If an error + occurs and STAT is a 'NULL' pointer, the function shall abort with printing an error message and starting the error termination. If no error occurs and STAT is present, it shall be set to zero. - Otherwise, it shall be set to a positive value and, if not-`NULL', - ERRMSG shall be set to a string describing the failure. The - function shall return a pointer to the requested memory for the - local image as a call to `malloc' would do. - - For `CAF_REGTYPE_COARRAY_STATIC' and `CAF_REGTYPE_COARRAY_ALLOC', + Otherwise, it shall be set to a positive value and, if not-'NULL', + ERRMSG shall be set to a string describing the failure. The + routine shall register the memory provided in the 'DATA'-component + of the array descriptor DESC, when that component is non-'NULL', + else it shall allocate sufficient memory and provide a pointer to + it in the 'DATA'-component of DESC. The array descriptor has rank + zero, when a scalar object is to be registered and the array + descriptor may be invalid after the call to + '_gfortran_caf_register'. When an array is to be allocated the + descriptor persists. + + For 'CAF_REGTYPE_COARRAY_STATIC' and 'CAF_REGTYPE_COARRAY_ALLOC', the passed size is the byte size requested. For - `CAF_REGTYPE_LOCK_STATIC', `CAF_REGTYPE_LOCK_ALLOC' and - `CAF_REGTYPE_CRITICAL' it is the array size or one for a scalar. + 'CAF_REGTYPE_LOCK_STATIC', 'CAF_REGTYPE_LOCK_ALLOC' and + 'CAF_REGTYPE_CRITICAL' it is the array size or one for a scalar. + + When 'CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY' is used, then only a + token for an allocatable or pointer component is created. The + 'SIZE' parameter is not used then. On the contrary when + 'CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY' is specified, then the + TOKEN needs to be registered by a previous call with regtype + 'CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY' and either the memory + specified in the DESC's data-ptr is registered or allocate when the + data-ptr is NULL. _Syntax_: - `void *caf_register (size_t size, caf_register_t type, caf_token_t - *token, int *stat, char *errmsg, int errmsg_len)' + 'void caf_register (size_t size, caf_register_t type, caf_token_t + *token, gfc_descriptor_t *desc, int *stat, char *errmsg, int + errmsg_len)' _Arguments_: - SIZE For normal coarrays, the byte size of the - coarray to be allocated; for lock types and - event types, the number of elements. - TYPE one of the caf_register_t types. - TOKEN intent(out) An opaque pointer identifying the - coarray. - STAT intent(out) For allocatable coarrays, stores - the STAT=; may be NULL - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + SIZE For normal coarrays, the byte size of the + coarray to be allocated; for lock types and + event types, the number of elements. + TYPE one of the caf_register_t types. + TOKEN intent(out) An opaque pointer identifying the + coarray. + DESC intent(inout) The (pseudo) array descriptor. + STAT intent(out) For allocatable coarrays, stores the + STAT=; may be NULL + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL + ERRMSG_LEN the buffer size of errmsg. _NOTES_ Nonalloatable coarrays have to be registered prior use from remote images. In order to guarantee this, they have to be registered - before the main program. This can be achieved by creating - constructor functions. That is what GCC does such that also + before the main program. This can be achieved by creating + constructor functions. That is what GCC does such that also nonallocatable coarrays the memory is allocated and no static memory is used. The token permits to identify the coarray; to the - processor, the token is a nonaliasing pointer. The library can, + processor, the token is a nonaliasing pointer. The library can, for instance, store the base address of the coarray in the token, - some handle or a more complicated struct. + some handle or a more complicated struct. The library may also + store the array descriptor DESC when its rank is non-zero. - For normal coarrays, the returned pointer is used for accesses on - the local image. For lock types, the value shall only used for - checking the allocation status. Note that for critical blocks, the - locking is only required on one image; in the locking statement, - the processor shall always pass always an image index of one for - critical-block lock variables (`CAF_REGTYPE_CRITICAL'). For lock - types and critical-block variables, the initial value shall be - unlocked (or, respecitively, not in critical section) such as the - value false; for event types, the initial state should be no - event, e.g. zero. + For lock types, the value shall only used for checking the + allocation status. Note that for critical blocks, the locking is + only required on one image; in the locking statement, the processor + shall always pass an image index of one for critical-block lock + variables ('CAF_REGTYPE_CRITICAL'). For lock types and + critical-block variables, the initial value shall be unlocked (or, + respecitively, not in critical section) such as the value false; + for event types, the initial state should be no event, e.g. zero. -File: gfortran.info, Node: _gfortran_caf_deregister, Next: _gfortran_caf_send, Prev: _gfortran_caf_register, Up: Function ABI Documentation +File: gfortran.info, Node: _gfortran_caf_deregister, Next: _gfortran_caf_is_present, Prev: _gfortran_caf_register, Up: Function ABI Documentation -8.2.6 `_gfortran_caf_deregister' -- Deregistering coarrays +8.2.9 '_gfortran_caf_deregister' -- Deregistering coarrays ---------------------------------------------------------- _Description_: - Called to free the memory of a coarray; the processor calls this - function for automatic and explicit deallocation. In case of an - error, this function shall fail with an error message, unless the - STAT variable is not null. + Called to free or deregister the memory of a coarray; the processor + calls this function for automatic and explicit deallocation. In + case of an error, this function shall fail with an error message, + unless the STAT variable is not null. The library is only expected + to free memory it allocated itself during a call to + '_gfortran_caf_register'. _Syntax_: - `void caf_deregister (const caf_token_t *token, int *stat, char - *errmsg, int errmsg_len)' + 'void caf_deregister (caf_token_t *token, caf_deregister_t type, + int *stat, char *errmsg, int errmsg_len)' _Arguments_: - STAT intent(out) Stores the STAT=; may be NULL - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + TOKEN the token to free. + TYPE the type of action to take for the coarray. A + 'CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY' is + allowed only for allocatable or pointer + components of derived type coarrays. The action + only deallocates the local memory without + deleting the token. + STAT intent(out) Stores the STAT=; may be NULL + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL + ERRMSG_LEN the buffer size of errmsg. _NOTES_ For nonalloatable coarrays this function is never called. If a @@ -4732,223 +5328,464 @@ _NOTES_ error stop functions, and via destructors. -File: gfortran.info, Node: _gfortran_caf_send, Next: _gfortran_caf_get, Prev: _gfortran_caf_deregister, Up: Function ABI Documentation +File: gfortran.info, Node: _gfortran_caf_is_present, Next: _gfortran_caf_send, Prev: _gfortran_caf_deregister, Up: Function ABI Documentation -8.2.7 `_gfortran_caf_send' -- Sending data from a local image to a remote image -------------------------------------------------------------------------------- +8.2.10 '_gfortran_caf_is_present' -- Query whether an allocatable or pointer component in a derived type coarray is allocated +----------------------------------------------------------------------------------------------------------------------------- _Description_: - Called to send a scalar, an array section or whole array from a + Used to query the coarray library whether an allocatable component + in a derived type coarray is allocated on a remote image. + +_Syntax_: + 'void _gfortran_caf_is_present (caf_token_t token, int image_index, + gfc_reference_t *ref)' + +_Arguments_: + TOKEN An opaque pointer identifying the coarray. + IMAGE_INDEX The ID of the remote image; must be a positive + number. + REF A chain of references to address the allocatable + or pointer component in the derived type + coarray. The object reference needs to be a + scalar or a full array reference, respectively. + + +File: gfortran.info, Node: _gfortran_caf_send, Next: _gfortran_caf_get, Prev: _gfortran_caf_is_present, Up: Function ABI Documentation + +8.2.11 '_gfortran_caf_send' -- Sending data from a local image to a remote image +-------------------------------------------------------------------------------- + +_Description_: + Called to send a scalar, an array section or a whole array from a local to a remote image identified by the image_index. _Syntax_: - `void _gfortran_caf_send (caf_token_t token, size_t offset, int + 'void _gfortran_caf_send (caf_token_t token, size_t offset, int image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector, gfc_descriptor_t *src, int dst_kind, int src_kind, bool - may_require_tmp)' - -_Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - OFFSET By which amount of bytes the actual data is - shifted compared to the base address of the - coarray. - IMAGE_INDEXThe ID of the remote image; must be a positive - number. - DEST intent(in) Array descriptor for the remote - image for the bounds and the size. The - base_addr shall not be accessed. - DST_VECTOR intent(int) If not NULL, it contains the - vector subscript of the destination array; the - values are relative to the dimension triplet - of the dest argument. - SRC intent(in) Array descriptor of the local array - to be transferred to the remote image - DST_KIND Kind of the destination argument - SRC_KIND Kind of the source argument - MAY_REQUIRE_TMPThe variable is false it is known at compile - time that the DEST and SRC either cannot - overlap or overlap (fully or partially) such - that walking SRC and DEST in element wise - element order (honoring the stride value) will - not lead to wrong results. Otherwise, the - value is true. + may_require_tmp, int *stat)' + +_Arguments_: + TOKEN intent(in) An opaque pointer identifying the + coarray. + OFFSET intent(in) By which amount of bytes the actual + data is shifted compared to the base address of + the coarray. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number. + DEST intent(in) Array descriptor for the remote image + for the bounds and the size. The 'base_addr' + shall not be accessed. + DST_VECTOR intent(in) If not NULL, it contains the vector + subscript of the destination array; the values + are relative to the dimension triplet of the + dest argument. + SRC intent(in) Array descriptor of the local array + to be transferred to the remote image + DST_KIND intent(in) Kind of the destination argument + SRC_KIND intent(in) Kind of the source argument + MAY_REQUIRE_TMPintent(in) The variable is 'false' when it is + known at compile time that the DEST and SRC + either cannot overlap or overlap (fully or + partially) such that walking SRC and DEST in + element wise element order (honoring the stride + value) will not lead to wrong results. + Otherwise, the value is 'true'. + STAT intent(out) when non-NULL give the result of the + operation, i.e., zero on success and non-zero on + error. When NULL and an error occurs, then an + error message is printed and the program is + terminated. _NOTES_ - It is permitted to have image_id equal the current image; the + It is permitted to have IMAGE_INDEX equal the current image; the memory of the send-to and the send-from might (partially) overlap - in that case. The implementation has to take care that it handles - this case, e.g. using `memmove' which handles (partially) - overlapping memory. If MAY_REQUIRE_TMP is true, the library might + in that case. The implementation has to take care that it handles + this case, e.g. using 'memmove' which handles (partially) + overlapping memory. If MAY_REQUIRE_TMP is true, the library might additionally create a temporary variable, unless additional checks - show that this is not required (e.g. because walking backward is - possible or because both arrays are contiguous and `memmove' takes + show that this is not required (e.g. because walking backward is + possible or because both arrays are contiguous and 'memmove' takes care of overlap issues). - Note that the assignment of a scalar to an array is permitted. In - addition, the library has to handle numeric-type conversion and - for strings, padding and different character kinds. + Note that the assignment of a scalar to an array is permitted. In + addition, the library has to handle numeric-type conversion and for + strings, padding and different character kinds. File: gfortran.info, Node: _gfortran_caf_get, Next: _gfortran_caf_sendget, Prev: _gfortran_caf_send, Up: Function ABI Documentation -8.2.8 `_gfortran_caf_get' -- Getting data from a remote image -------------------------------------------------------------- +8.2.12 '_gfortran_caf_get' -- Getting data from a remote image +-------------------------------------------------------------- _Description_: - Called to get an array section or whole array from a a remote, + Called to get an array section or a whole array from a remote, image identified by the image_index. _Syntax_: - `void _gfortran_caf_get_desc (caf_token_t token, size_t offset, - int image_index, gfc_descriptor_t *src, caf_vector_t *src_vector, + 'void _gfortran_caf_get (caf_token_t token, size_t offset, int + image_index, gfc_descriptor_t *src, caf_vector_t *src_vector, gfc_descriptor_t *dest, int src_kind, int dst_kind, bool - may_require_tmp)' - -_Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - OFFSET By which amount of bytes the actual data is - shifted compared to the base address of the - coarray. - IMAGE_INDEXThe ID of the remote image; must be a positive - number. - DEST intent(in) Array descriptor of the local array - to be transferred to the remote image - SRC intent(in) Array descriptor for the remote - image for the bounds and the size. The - base_addr shall not be accessed. - SRC_VECTOR intent(int) If not NULL, it contains the - vector subscript of the destination array; the - values are relative to the dimension triplet - of the dest argument. - DST_KIND Kind of the destination argument - SRC_KIND Kind of the source argument - MAY_REQUIRE_TMPThe variable is false it is known at compile - time that the DEST and SRC either cannot - overlap or overlap (fully or partially) such - that walking SRC and DEST in element wise - element order (honoring the stride value) will - not lead to wrong results. Otherwise, the - value is true. + may_require_tmp, int *stat)' + +_Arguments_: + TOKEN intent(in) An opaque pointer identifying the + coarray. + OFFSET intent(in) By which amount of bytes the actual + data is shifted compared to the base address of + the coarray. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number. + DEST intent(out) Array descriptor of the local array + to store the data retrieved from the remote + image + SRC intent(in) Array descriptor for the remote image + for the bounds and the size. The 'base_addr' + shall not be accessed. + SRC_VECTOR intent(in) If not NULL, it contains the vector + subscript of the source array; the values are + relative to the dimension triplet of the SRC + argument. + DST_KIND intent(in) Kind of the destination argument + SRC_KIND intent(in) Kind of the source argument + MAY_REQUIRE_TMPintent(in) The variable is 'false' when it is + known at compile time that the DEST and SRC + either cannot overlap or overlap (fully or + partially) such that walking SRC and DEST in + element wise element order (honoring the stride + value) will not lead to wrong results. + Otherwise, the value is 'true'. + STAT intent(out) When non-NULL give the result of the + operation, i.e., zero on success and non-zero on + error. When NULL and an error occurs, then an + error message is printed and the program is + terminated. _NOTES_ - It is permitted to have image_id equal the current image; the + It is permitted to have IMAGE_INDEX equal the current image; the memory of the send-to and the send-from might (partially) overlap - in that case. The implementation has to take care that it handles - this case, e.g. using `memmove' which handles (partially) - overlapping memory. If MAY_REQUIRE_TMP is true, the library might + in that case. The implementation has to take care that it handles + this case, e.g. using 'memmove' which handles (partially) + overlapping memory. If MAY_REQUIRE_TMP is true, the library might additionally create a temporary variable, unless additional checks - show that this is not required (e.g. because walking backward is - possible or because both arrays are contiguous and `memmove' takes + show that this is not required (e.g. because walking backward is + possible or because both arrays are contiguous and 'memmove' takes care of overlap issues). - Note that the library has to handle numeric-type conversion and - for strings, padding and different character kinds. + Note that the library has to handle numeric-type conversion and for + strings, padding and different character kinds. -File: gfortran.info, Node: _gfortran_caf_sendget, Next: _gfortran_caf_lock, Prev: _gfortran_caf_get, Up: Function ABI Documentation +File: gfortran.info, Node: _gfortran_caf_sendget, Next: _gfortran_caf_send_by_ref, Prev: _gfortran_caf_get, Up: Function ABI Documentation -8.2.9 `_gfortran_caf_sendget' -- Sending data between remote images -------------------------------------------------------------------- +8.2.13 '_gfortran_caf_sendget' -- Sending data between remote images +-------------------------------------------------------------------- _Description_: - Called to send a scalar, an array section or whole array from a - remote image identified by the src_image_index to a remote image - identified by the dst_image_index. + Called to send a scalar, an array section or a whole array from a + remote image identified by the SRC_IMAGE_INDEX to a remote image + identified by the DST_IMAGE_INDEX. _Syntax_: - `void _gfortran_caf_sendget (caf_token_t dst_token, size_t + 'void _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset, int dst_image_index, gfc_descriptor_t *dest, - caf_vector_t *dst_vector, caf_token_t src_token, size_t - src_offset, int src_image_index, gfc_descriptor_t *src, - caf_vector_t *src_vector, int dst_kind, int src_kind, bool - may_require_tmp)' - -_Arguments_: - DST_TOKEN intent(in) An opaque pointer identifying the - destination coarray. - DST_OFFSET By which amount of bytes the actual data is - shifted compared to the base address of the - destination coarray. - DST_IMAGE_INDEXThe ID of the destination remote image; must - be a positive number. - DEST intent(in) Array descriptor for the destination - remote image for the bounds and the size. The - base_addr shall not be accessed. - DST_VECTOR intent(int) If not NULL, it contains the - vector subscript of the destination array; the - values are relative to the dimension triplet - of the dest argument. - SRC_TOKEN An opaque pointer identifying the source - coarray. - SRC_OFFSET By which amount of bytes the actual data is - shifted compared to the base address of the - source coarray. - SRC_IMAGE_INDEXThe ID of the source remote image; must be a - positive number. - SRC intent(in) Array descriptor of the local array - to be transferred to the remote image. - SRC_VECTOR intent(in) Array descriptor of the local array - to be transferred to the remote image - DST_KIND Kind of the destination argument - SRC_KIND Kind of the source argument - MAY_REQUIRE_TMPThe variable is false it is known at compile - time that the DEST and SRC either cannot - overlap or overlap (fully or partially) such - that walking SRC and DEST in element wise - element order (honoring the stride value) will - not lead to wrong results. Otherwise, the - value is true. + caf_vector_t *dst_vector, caf_token_t src_token, size_t src_offset, + int src_image_index, gfc_descriptor_t *src, caf_vector_t + *src_vector, int dst_kind, int src_kind, bool may_require_tmp, int + *stat)' + +_Arguments_: + DST_TOKEN intent(in) An opaque pointer identifying the + destination coarray. + DST_OFFSET intent(in) By which amount of bytes the actual + data is shifted compared to the base address of + the destination coarray. + DST_IMAGE_INDEXintent(in) The ID of the destination remote + image; must be a positive number. + DEST intent(in) Array descriptor for the destination + remote image for the bounds and the size. The + 'base_addr' shall not be accessed. + DST_VECTOR intent(int) If not NULL, it contains the vector + subscript of the destination array; the values + are relative to the dimension triplet of the + DEST argument. + SRC_TOKEN intent(in) An opaque pointer identifying the + source coarray. + SRC_OFFSET intent(in) By which amount of bytes the actual + data is shifted compared to the base address of + the source coarray. + SRC_IMAGE_INDEXintent(in) The ID of the source remote image; + must be a positive number. + SRC intent(in) Array descriptor of the local array + to be transferred to the remote image. + SRC_VECTOR intent(in) Array descriptor of the local array + to be transferred to the remote image + DST_KIND intent(in) Kind of the destination argument + SRC_KIND intent(in) Kind of the source argument + MAY_REQUIRE_TMPintent(in) The variable is 'false' when it is + known at compile time that the DEST and SRC + either cannot overlap or overlap (fully or + partially) such that walking SRC and DEST in + element wise element order (honoring the stride + value) will not lead to wrong results. + Otherwise, the value is 'true'. + STAT intent(out) when non-NULL give the result of the + operation, i.e., zero on success and non-zero on + error. When NULL and an error occurs, then an + error message is printed and the program is + terminated. + +_NOTES_ + It is permitted to have the same image index for both + SRC_IMAGE_INDEX and DST_IMAGE_INDEX; the memory of the send-to and + the send-from might (partially) overlap in that case. The + implementation has to take care that it handles this case, e.g. + using 'memmove' which handles (partially) overlapping memory. If + MAY_REQUIRE_TMP is true, the library might additionally create a + temporary variable, unless additional checks show that this is not + required (e.g. because walking backward is possible or because + both arrays are contiguous and 'memmove' takes care of overlap + issues). + + Note that the assignment of a scalar to an array is permitted. In + addition, the library has to handle numeric-type conversion and for + strings, padding and different character kinds. + + +File: gfortran.info, Node: _gfortran_caf_send_by_ref, Next: _gfortran_caf_get_by_ref, Prev: _gfortran_caf_sendget, Up: Function ABI Documentation + +8.2.14 '_gfortran_caf_send_by_ref' -- Sending data from a local image to a remote image with enhanced referencing options +------------------------------------------------------------------------------------------------------------------------- + +_Description_: + Called to send a scalar, an array section or a whole array from a + local to a remote image identified by the IMAGE_INDEX. + +_Syntax_: + 'void _gfortran_caf_send_by_ref (caf_token_t token, int + image_index, gfc_descriptor_t *src, caf_reference_t *refs, int + dst_kind, int src_kind, bool may_require_tmp, bool + dst_reallocatable, int *stat)' + +_Arguments_: + TOKEN intent(in) An opaque pointer identifying the + coarray. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number. + SRC intent(in) Array descriptor of the local array + to be transferred to the remote image + REFS intent(in) The references on the remote array to + store the data given by src. Guaranteed to have + at least one entry. + DST_KIND intent(in) Kind of the destination argument + SRC_KIND intent(in) Kind of the source argument + MAY_REQUIRE_TMPintent(in) The variable is 'false' when it is + known at compile time that the DEST and SRC + either cannot overlap or overlap (fully or + partially) such that walking SRC and DEST in + element wise element order (honoring the stride + value) will not lead to wrong results. + Otherwise, the value is 'true'. + DST_REALLOCATABLEintent(in) Set when the destination is of + allocatable or pointer type and the refs will + allow reallocation, i.e., the ref is a full + array or component ref. + STAT intent(out) When non-'NULL' give the result of + the operation, i.e., zero on success and + non-zero on error. When 'NULL' and an error + occurs, then an error message is printed and the + program is terminated. + +_NOTES_ + It is permitted to have IMAGE_INDEX equal the current image; the + memory of the send-to and the send-from might (partially) overlap + in that case. The implementation has to take care that it handles + this case, e.g. using 'memmove' which handles (partially) + overlapping memory. If MAY_REQUIRE_TMP is true, the library might + additionally create a temporary variable, unless additional checks + show that this is not required (e.g. because walking backward is + possible or because both arrays are contiguous and 'memmove' takes + care of overlap issues). + + Note that the assignment of a scalar to an array is permitted. In + addition, the library has to handle numeric-type conversion and for + strings, padding and different character kinds. + + Because of the more complicated references possible some operations + may be unsupported by certain libraries. The library is expected + to issue a precise error message why the operation is not + permitted. + + +File: gfortran.info, Node: _gfortran_caf_get_by_ref, Next: _gfortran_caf_sendget_by_ref, Prev: _gfortran_caf_send_by_ref, Up: Function ABI Documentation + +8.2.15 '_gfortran_caf_get_by_ref' -- Getting data from a remote image using enhanced references +----------------------------------------------------------------------------------------------- + +_Description_: + Called to get a scalar, an array section or a whole array from a + remote image identified by the IMAGE_INDEX. + +_Syntax_: + 'void _gfortran_caf_get_by_ref (caf_token_t token, int image_index, + caf_reference_t *refs, gfc_descriptor_t *dst, int dst_kind, int + src_kind, bool may_require_tmp, bool dst_reallocatable, int *stat)' + +_Arguments_: + TOKEN intent(in) An opaque pointer identifying the + coarray. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number. + REFS intent(in) The references to apply to the remote + structure to get the data. + DST intent(in) Array descriptor of the local array + to store the data transferred from the remote + image. May be reallocated where needed and when + DST_REALLOCATABLE allows it. + DST_KIND intent(in) Kind of the destination argument + SRC_KIND intent(in) Kind of the source argument + MAY_REQUIRE_TMPintent(in) The variable is 'false' when it is + known at compile time that the DEST and SRC + either cannot overlap or overlap (fully or + partially) such that walking SRC and DEST in + element wise element order (honoring the stride + value) will not lead to wrong results. + Otherwise, the value is 'true'. + DST_REALLOCATABLEintent(in) Set when DST is of allocatable or + pointer type and its refs allow reallocation, + i.e., the full array or a component is + referenced. + STAT intent(out) When non-'NULL' give the result of + the operation, i.e., zero on success and + non-zero on error. When 'NULL' and an error + occurs, then an error message is printed and the + program is terminated. _NOTES_ - It is permitted to have image_ids equal; the memory of the send-to - and the send-from might (partially) overlap in that case. The + It is permitted to have 'image_index' equal the current image; the + memory of the send-to and the send-from might (partially) overlap + in that case. The implementation has to take care that it handles + this case, e.g. using 'memmove' which handles (partially) + overlapping memory. If MAY_REQUIRE_TMP is true, the library might + additionally create a temporary variable, unless additional checks + show that this is not required (e.g. because walking backward is + possible or because both arrays are contiguous and 'memmove' takes + care of overlap issues). + + Note that the library has to handle numeric-type conversion and for + strings, padding and different character kinds. + + Because of the more complicated references possible some operations + may be unsupported by certain libraries. The library is expected + to issue a precise error message why the operation is not + permitted. + + +File: gfortran.info, Node: _gfortran_caf_sendget_by_ref, Next: _gfortran_caf_lock, Prev: _gfortran_caf_get_by_ref, Up: Function ABI Documentation + +8.2.16 '_gfortran_caf_sendget_by_ref' -- Sending data between remote images using enhanced references on both sides +------------------------------------------------------------------------------------------------------------------- + +_Description_: + Called to send a scalar, an array section or a whole array from a + remote image identified by the SRC_IMAGE_INDEX to a remote image + identified by the DST_IMAGE_INDEX. + +_Syntax_: + 'void _gfortran_caf_sendget_by_ref (caf_token_t dst_token, int + dst_image_index, caf_reference_t *dst_refs, caf_token_t src_token, + int src_image_index, caf_reference_t *src_refs, int dst_kind, int + src_kind, bool may_require_tmp, int *dst_stat, int *src_stat)' + +_Arguments_: + DST_TOKEN intent(in) An opaque pointer identifying the + destination coarray. + DST_IMAGE_INDEXintent(in) The ID of the destination remote + image; must be a positive number. + DST_REFS intent(in) The references on the remote array to + store the data given by the source. Guaranteed + to have at least one entry. + SRC_TOKEN intent(in) An opaque pointer identifying the + source coarray. + SRC_IMAGE_INDEXintent(in) The ID of the source remote image; + must be a positive number. + SRC_REFS intent(in) The references to apply to the remote + structure to get the data. + DST_KIND intent(in) Kind of the destination argument + SRC_KIND intent(in) Kind of the source argument + MAY_REQUIRE_TMPintent(in) The variable is 'false' when it is + known at compile time that the DEST and SRC + either cannot overlap or overlap (fully or + partially) such that walking SRC and DEST in + element wise element order (honoring the stride + value) will not lead to wrong results. + Otherwise, the value is 'true'. + DST_STAT intent(out) when non-'NULL' give the result of + the send-operation, i.e., zero on success and + non-zero on error. When 'NULL' and an error + occurs, then an error message is printed and the + program is terminated. + SRC_STAT intent(out) When non-'NULL' give the result of + the get-operation, i.e., zero on success and + non-zero on error. When 'NULL' and an error + occurs, then an error message is printed and the + program is terminated. + +_NOTES_ + It is permitted to have the same image index for both + SRC_IMAGE_INDEX and DST_IMAGE_INDEX; the memory of the send-to and + the send-from might (partially) overlap in that case. The implementation has to take care that it handles this case, e.g. - using `memmove' which handles (partially) overlapping memory. If + using 'memmove' which handles (partially) overlapping memory. If MAY_REQUIRE_TMP is true, the library might additionally create a temporary variable, unless additional checks show that this is not - required (e.g. because walking backward is possible or because - both arrays are contiguous and `memmove' takes care of overlap + required (e.g. because walking backward is possible or because + both arrays are contiguous and 'memmove' takes care of overlap issues). - Note that the assignment of a scalar to an array is permitted. In - addition, the library has to handle numeric-type conversion and - for strings, padding and different character kinds. + Note that the assignment of a scalar to an array is permitted. In + addition, the library has to handle numeric-type conversion and for + strings, padding and different character kinds. + + Because of the more complicated references possible some operations + may be unsupported by certain libraries. The library is expected + to issue a precise error message why the operation is not + permitted. -File: gfortran.info, Node: _gfortran_caf_lock, Next: _gfortran_caf_unlock, Prev: _gfortran_caf_sendget, Up: Function ABI Documentation +File: gfortran.info, Node: _gfortran_caf_lock, Next: _gfortran_caf_unlock, Prev: _gfortran_caf_sendget_by_ref, Up: Function ABI Documentation -8.2.10 `_gfortran_caf_lock' -- Locking a lock variable +8.2.17 '_gfortran_caf_lock' -- Locking a lock variable ------------------------------------------------------ _Description_: Acquire a lock on the given image on a scalar locking variable or - for the given array element for an array-valued variable. If the - AQUIRED_LOCK is `NULL', the function return after having obtained - the lock. If it is nonnull, the result is is assigned the value - true (one) when the lock could be obtained and false (zero) + for the given array element for an array-valued variable. If the + AQUIRED_LOCK is 'NULL', the function returns after having obtained + the lock. If it is non-'NULL', then ACQUIRED_LOCK is assigned the + value true (one) when the lock could be obtained and false (zero) otherwise. Locking a lock variable which has already been locked by the same image is an error. _Syntax_: - `void _gfortran_caf_lock (caf_token_t token, size_t index, int + 'void _gfortran_caf_lock (caf_token_t token, size_t index, int image_index, int *aquired_lock, int *stat, char *errmsg, int errmsg_len)' _Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - INDEX Array index; first array index is 0. For - scalars, it is always 0. - IMAGE_INDEXThe ID of the remote image; must be a positive - number. - AQUIRED_LOCKintent(out) If not NULL, it returns whether - lock could be obtained - STAT intent(out) Stores the STAT=; may be NULL - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + TOKEN intent(in) An opaque pointer identifying the + coarray. + INDEX intent(in) Array index; first array index is 0. + For scalars, it is always 0. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number. + AQUIRED_LOCKintent(out) If not NULL, it returns whether lock + could be obtained. + STAT intent(out) Stores the STAT=; may be NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + ERRMSG_LEN intent(in) the buffer size of errmsg _NOTES_ This function is also called for critical blocks; for those, the @@ -4959,31 +5796,31 @@ _NOTES_ File: gfortran.info, Node: _gfortran_caf_unlock, Next: _gfortran_caf_event_post, Prev: _gfortran_caf_lock, Up: Function ABI Documentation -8.2.11 `_gfortran_caf_lock' -- Unlocking a lock variable +8.2.18 '_gfortran_caf_lock' -- Unlocking a lock variable -------------------------------------------------------- _Description_: Release a lock on the given image on a scalar locking variable or for the given array element for an array-valued variable. - Unlocking a lock variable which is unlocked or has been locked by - a different image is an error. + Unlocking a lock variable which is unlocked or has been locked by a + different image is an error. _Syntax_: - `void _gfortran_caf_unlock (caf_token_t token, size_t index, int + 'void _gfortran_caf_unlock (caf_token_t token, size_t index, int image_index, int *stat, char *errmsg, int errmsg_len)' _Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - INDEX Array index; first array index is 0. For - scalars, it is always 0. - IMAGE_INDEXThe ID of the remote image; must be a positive - number. - STAT intent(out) For allocatable coarrays, stores - the STAT=; may be NULL - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + TOKEN intent(in) An opaque pointer identifying the + coarray. + INDEX intent(in) Array index; first array index is 0. + For scalars, it is always 0. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number. + STAT intent(out) For allocatable coarrays, stores the + STAT=; may be NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + ERRMSG_LEN intent(in) the buffer size of errmsg _NOTES_ This function is also called for critical block; for those, the @@ -4994,40 +5831,40 @@ _NOTES_ File: gfortran.info, Node: _gfortran_caf_event_post, Next: _gfortran_caf_event_wait, Prev: _gfortran_caf_unlock, Up: Function ABI Documentation -8.2.12 `_gfortran_caf_event_post' -- Post an event +8.2.19 '_gfortran_caf_event_post' -- Post an event -------------------------------------------------- _Description_: Increment the event count of the specified event variable. _Syntax_: - `void _gfortran_caf_event_post (caf_token_t token, size_t index, + 'void _gfortran_caf_event_post (caf_token_t token, size_t index, int image_index, int *stat, char *errmsg, int errmsg_len)' _Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - INDEX Array index; first array index is 0. For - scalars, it is always 0. - IMAGE_INDEXThe ID of the remote image; must be a positive - number; zero indicates the current image when - accessed noncoindexed. - STAT intent(out) Stores the STAT=; may be NULL - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + TOKEN intent(in) An opaque pointer identifying the + coarray. + INDEX intent(in) Array index; first array index is 0. + For scalars, it is always 0. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number; zero indicates the current + image, when accessed noncoindexed. + STAT intent(out) Stores the STAT=; may be NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + ERRMSG_LEN intent(in) the buffer size of errmsg _NOTES_ This acts like an atomic add of one to the remote image's event - variable. The statement is an image-control statement but does - not imply sync memory. Still, all preceeding push communications - of this image to the specified remote image has to be completed - before `event_wait' on the remote image returns. + variable. The statement is an image-control statement but does not + imply sync memory. Still, all preceeding push communications of + this image to the specified remote image have to be completed + before 'event_wait' on the remote image returns. File: gfortran.info, Node: _gfortran_caf_event_wait, Next: _gfortran_caf_event_query, Prev: _gfortran_caf_event_post, Up: Function ABI Documentation -8.2.13 `_gfortran_caf_event_wait' -- Wait that an event occurred +8.2.20 '_gfortran_caf_event_wait' -- Wait that an event occurred ---------------------------------------------------------------- _Description_: @@ -5036,66 +5873,66 @@ _Description_: amount and return. _Syntax_: - `void _gfortran_caf_event_wait (caf_token_t token, size_t index, + 'void _gfortran_caf_event_wait (caf_token_t token, size_t index, int until_count, int *stat, char *errmsg, int errmsg_len)' _Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - INDEX Array index; first array index is 0. For - scalars, it is always 0. - UNTIL_COUNTThe number of events which have to be available - before the function returns. - STAT intent(out) Stores the STAT=; may be NULL - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + TOKEN intent(in) An opaque pointer identifying the + coarray. + INDEX intent(in) Array index; first array index is 0. + For scalars, it is always 0. + UNTIL_COUNT intent(in) The number of events which have to be + available before the function returns. + STAT intent(out) Stores the STAT=; may be NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + ERRMSG_LEN intent(in) the buffer size of errmsg _NOTES_ - This function only operates on a local coarray. It acts like a + This function only operates on a local coarray. It acts like a loop checking atomically the value of the event variable, breaking if the value is greater or equal the requested number of counts. Before the function returns, the event variable has to be decremented by the requested UNTIL_COUNT value. A possible implementation would be a busy loop for a certain number of spins - (possibly depending on the number of threads relative to the - number of available cores) followed by other waiting strategy such - as a sleeping wait (possibly with an increasing number of sleep - time) or, if possible, a futex wait. + (possibly depending on the number of threads relative to the number + of available cores) followed by another waiting strategy such as a + sleeping wait (possibly with an increasing number of sleep time) + or, if possible, a futex wait. - The statement is an image-control statement but does not imply - sync memory. Still, all preceeding push communications to this - image of images having issued a `event_push' have to be completed - before this function returns. + The statement is an image-control statement but does not imply sync + memory. Still, all preceeding push communications of this image to + the specified remote image have to be completed before 'event_wait' + on the remote image returns. File: gfortran.info, Node: _gfortran_caf_event_query, Next: _gfortran_caf_sync_all, Prev: _gfortran_caf_event_wait, Up: Function ABI Documentation -8.2.14 `_gfortran_caf_event_query' -- Query event count +8.2.21 '_gfortran_caf_event_query' -- Query event count ------------------------------------------------------- _Description_: - Return the event count of the specified event count. + Return the event count of the specified event variable. _Syntax_: - `void _gfortran_caf_event_query (caf_token_t token, size_t index, + 'void _gfortran_caf_event_query (caf_token_t token, size_t index, int image_index, int *count, int *stat)' _Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - INDEX Array index; first array index is 0. For - scalars, it is always 0. - IMAGE_INDEXThe ID of the remote image; must be a positive - number; zero indicates the current image when - accessed noncoindexed. - COUNT intent(out) The number of events currently - posted to the event variable - STAT intent(out) Stores the STAT=; may be NULL + TOKEN intent(in) An opaque pointer identifying the + coarray. + INDEX intent(in) Array index; first array index is 0. + For scalars, it is always 0. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number; zero indicates the current + image when accessed noncoindexed. + COUNT intent(out) The number of events currently + posted to the event variable. + STAT intent(out) Stores the STAT=; may be NULL. _NOTES_ - The typical use is to check the local even variable to only call - `event_wait' when the data is available. However, a coindexed + The typical use is to check the local event variable to only call + 'event_wait' when the data is available. However, a coindexed variable is permitted; there is no ordering or synchronization implied. It acts like an atomic fetch of the value of the event variable. @@ -5103,155 +5940,171 @@ _NOTES_ File: gfortran.info, Node: _gfortran_caf_sync_all, Next: _gfortran_caf_sync_images, Prev: _gfortran_caf_event_query, Up: Function ABI Documentation -8.2.15 `_gfortran_caf_sync_all' -- All-image barrier +8.2.22 '_gfortran_caf_sync_all' -- All-image barrier ---------------------------------------------------- _Description_: - Synchronization of all images in the current team; the program - only continues on a given image after this function has been - called on all images of the current team. Additionally, it - ensures that all pending data transfers of previous segment have - completed. + Synchronization of all images in the current team; the program only + continues on a given image after this function has been called on + all images of the current team. Additionally, it ensures that all + pending data transfers of previous segment have completed. _Syntax_: - `void _gfortran_caf_sync_all (int *stat, char *errmsg, int + 'void _gfortran_caf_sync_all (int *stat, char *errmsg, int errmsg_len)' _Arguments_: - STAT intent(out) Stores the status STAT= and may be - NULL. - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + STAT intent(out) Stores the status STAT= and may be + NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + ERRMSG_LEN intent(in) the buffer size of errmsg File: gfortran.info, Node: _gfortran_caf_sync_images, Next: _gfortran_caf_sync_memory, Prev: _gfortran_caf_sync_all, Up: Function ABI Documentation -8.2.16 `_gfortran_caf_sync_images' -- Barrier for selected images +8.2.23 '_gfortran_caf_sync_images' -- Barrier for selected images ----------------------------------------------------------------- _Description_: Synchronization between the specified images; the program only continues on a given image after this function has been called on - all images specified for that image. Note that one image can wait - for all other images in the current team (e.g. via `sync + all images specified for that image. Note that one image can wait + for all other images in the current team (e.g. via 'sync images(*)') while those only wait for that specific image. - Additionally, `sync images' it ensures that all pending data - transfers of previous segment have completed. + Additionally, 'sync images' ensures that all pending data transfers + of previous segments have completed. _Syntax_: - `void _gfortran_caf_sync_images (int count, int images[], int + 'void _gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg, int errmsg_len)' _Arguments_: - COUNT the number of images which are provided in the - next argument. For a zero-sized array, the - value is zero. For `sync images (*)', the - value is -1. - IMAGES intent(in) an array with the images provided - by the user. If COUNT is zero, a NULL pointer - is passed. - STAT intent(out) Stores the status STAT= and may be - NULL. - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + COUNT intent(in) The number of images which are + provided in the next argument. For a zero-sized + array, the value is zero. For 'sync images + (*)', the value is -1. + IMAGES intent(in) An array with the images provided by + the user. If COUNT is zero, a NULL pointer is + passed. + STAT intent(out) Stores the status STAT= and may be + NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + ERRMSG_LEN intent(in) the buffer size of errmsg File: gfortran.info, Node: _gfortran_caf_sync_memory, Next: _gfortran_caf_error_stop, Prev: _gfortran_caf_sync_images, Up: Function ABI Documentation -8.2.17 `_gfortran_caf_sync_memory' -- Wait for completion of segment-memory operations +8.2.24 '_gfortran_caf_sync_memory' -- Wait for completion of segment-memory operations -------------------------------------------------------------------------------------- _Description_: - Acts as optimization barrier between different segments. It also + Acts as optimization barrier between different segments. It also ensures that all pending memory operations of this image have been completed. _Syntax_: - `void _gfortran_caf_sync_memory (int *stat, char *errmsg, int + 'void _gfortran_caf_sync_memory (int *stat, char *errmsg, int errmsg_len)' _Arguments_: - STAT intent(out) Stores the status STAT= and may be - NULL. - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + STAT intent(out) Stores the status STAT= and may be + NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + ERRMSG_LEN intent(in) the buffer size of errmsg _NOTE_ A simple implementation could be - `__asm__ __volatile__ ("":::"memory")' to prevent code movements. + '__asm__ __volatile__ ("":::"memory")' to prevent code movements. File: gfortran.info, Node: _gfortran_caf_error_stop, Next: _gfortran_caf_error_stop_str, Prev: _gfortran_caf_sync_memory, Up: Function ABI Documentation -8.2.18 `_gfortran_caf_error_stop' -- Error termination with exit code +8.2.25 '_gfortran_caf_error_stop' -- Error termination with exit code --------------------------------------------------------------------- _Description_: - Invoked for an `ERROR STOP' statement which has an integer + Invoked for an 'ERROR STOP' statement which has an integer argument. The function should terminate the program with the specified exit code. _Syntax_: - `void _gfortran_caf_error_stop (int32_t error)' + 'void _gfortran_caf_error_stop (int32_t error)' _Arguments_: - ERROR the exit status to be used. + ERROR intent(in) The exit status to be used. -File: gfortran.info, Node: _gfortran_caf_error_stop_str, Next: _gfortran_caf_atomic_define, Prev: _gfortran_caf_error_stop, Up: Function ABI Documentation +File: gfortran.info, Node: _gfortran_caf_error_stop_str, Next: _gfortran_caf_fail_image, Prev: _gfortran_caf_error_stop, Up: Function ABI Documentation -8.2.19 `_gfortran_caf_error_stop_str' -- Error termination with string +8.2.26 '_gfortran_caf_error_stop_str' -- Error termination with string ---------------------------------------------------------------------- _Description_: - Invoked for an `ERROR STOP' statement which has a string as + Invoked for an 'ERROR STOP' statement which has a string as argument. The function should terminate the program with a nonzero-exit code. _Syntax_: - `void _gfortran_caf_error_stop (const char *string, int32_t len)' + 'void _gfortran_caf_error_stop (const char *string, int32_t len)' _Arguments_: - STRING the error message (not zero terminated) - LEN the length of the string + STRING intent(in) the error message (not zero + terminated) + LEN intent(in) the length of the string -File: gfortran.info, Node: _gfortran_caf_atomic_define, Next: _gfortran_caf_atomic_ref, Prev: _gfortran_caf_error_stop_str, Up: Function ABI Documentation +File: gfortran.info, Node: _gfortran_caf_fail_image, Next: _gfortran_caf_atomic_define, Prev: _gfortran_caf_error_stop_str, Up: Function ABI Documentation + +8.2.27 '_gfortran_caf_fail_image' -- Mark the image failed and end its execution +-------------------------------------------------------------------------------- + +_Description_: + Invoked for an 'FAIL IMAGE' statement. The function should + terminate the current image. + +_Syntax_: + 'void _gfortran_caf_fail_image ()' + +_NOTES_ + This function follows TS18508. -8.2.20 `_gfortran_caf_atomic_define' -- Atomic variable assignment + +File: gfortran.info, Node: _gfortran_caf_atomic_define, Next: _gfortran_caf_atomic_ref, Prev: _gfortran_caf_fail_image, Up: Function ABI Documentation + +8.2.28 '_gfortran_caf_atomic_define' -- Atomic variable assignment ------------------------------------------------------------------ _Description_: Assign atomically a value to an integer or logical variable. _Syntax_: - `void _gfortran_caf_atomic_define (caf_token_t token, size_t + 'void _gfortran_caf_atomic_define (caf_token_t token, size_t offset, int image_index, void *value, int *stat, int type, int kind)' _Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - OFFSET By which amount of bytes the actual data is - shifted compared to the base address of the - coarray. - IMAGE_INDEXThe ID of the remote image; must be a positive - number; zero indicates the current image when - used noncoindexed. - VALUE intent(in) the value to be assigned, passed by - reference. - STAT intent(out) Stores the status STAT= and may be - NULL. - TYPE the data type, i.e. `BT_INTEGER' (1) or - `BT_LOGICAL' (2). - KIND The kind value (only 4; always `int') + TOKEN intent(in) An opaque pointer identifying the + coarray. + OFFSET intent(in) By which amount of bytes the actual + data is shifted compared to the base address of + the coarray. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number; zero indicates the current + image when used noncoindexed. + VALUE intent(in) the value to be assigned, passed by + reference + STAT intent(out) Stores the status STAT= and may be + NULL. + TYPE intent(in) The data type, i.e. 'BT_INTEGER' (1) + or 'BT_LOGICAL' (2). + KIND intent(in) The kind value (only 4; always 'int') File: gfortran.info, Node: _gfortran_caf_atomic_ref, Next: _gfortran_caf_atomic_cas, Prev: _gfortran_caf_atomic_define, Up: Function ABI Documentation -8.2.21 `_gfortran_caf_atomic_ref' -- Atomic variable reference +8.2.29 '_gfortran_caf_atomic_ref' -- Atomic variable reference -------------------------------------------------------------- _Description_: @@ -5259,32 +6112,30 @@ _Description_: variable. _Syntax_: - `void _gfortran_caf_atomic_ref (caf_token_t token, size_t offset, + 'void _gfortran_caf_atomic_ref (caf_token_t token, size_t offset, int image_index, void *value, int *stat, int type, int kind)' _Arguments_: - -_Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - OFFSET By which amount of bytes the actual data is - shifted compared to the base address of the - coarray. - IMAGE_INDEXThe ID of the remote image; must be a positive - number; zero indicates the current image when - used noncoindexed. - VALUE intent(out) The variable assigned the - atomically referenced variable. - STAT intent(out) Stores the status STAT= and may be - NULL. - TYPE the data type, i.e. `BT_INTEGER' (1) or - `BT_LOGICAL' (2). - KIND The kind value (only 4; always `int') + TOKEN intent(in) An opaque pointer identifying the + coarray. + OFFSET intent(in) By which amount of bytes the actual + data is shifted compared to the base address of + the coarray. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number; zero indicates the current + image when used noncoindexed. + VALUE intent(out) The variable assigned the atomically + referenced variable. + STAT intent(out) Stores the status STAT= and may be + NULL. + TYPE the data type, i.e. 'BT_INTEGER' (1) or + 'BT_LOGICAL' (2). + KIND The kind value (only 4; always 'int') File: gfortran.info, Node: _gfortran_caf_atomic_cas, Next: _gfortran_caf_atomic_op, Prev: _gfortran_caf_atomic_ref, Up: Function ABI Documentation -8.2.22 `_gfortran_caf_atomic_cas' -- Atomic compare and swap +8.2.30 '_gfortran_caf_atomic_cas' -- Atomic compare and swap ------------------------------------------------------------ _Description_: @@ -5293,259 +6144,263 @@ _Description_: the latter has the value specified by the passed condition value. _Syntax_: - `void _gfortran_caf_atomic_cas (caf_token_t token, size_t offset, + 'void _gfortran_caf_atomic_cas (caf_token_t token, size_t offset, int image_index, void *old, void *compare, void *new_val, int *stat, int type, int kind)' _Arguments_: - TOKEN intent(in) An opaque pointer identifying the - coarray. - OFFSET By which amount of bytes the actual data is - shifted compared to the base address of the - coarray. - IMAGE_INDEXThe ID of the remote image; must be a positive - number; zero indicates the current image when - used noncoindexed. - OLD intent(out) the value which the atomic - variable had just before the cas operation. - COMPARE intent(in) The value used for comparision. - NEW_VAL intent(in) The new value for the atomic - variable, assigned to the atomic variable, if - `compare' equals the value of the atomic - variable. - STAT intent(out) Stores the status STAT= and may be - NULL. - TYPE the data type, i.e. `BT_INTEGER' (1) or - `BT_LOGICAL' (2). - KIND The kind value (only 4; always `int') + TOKEN intent(in) An opaque pointer identifying the + coarray. + OFFSET intent(in) By which amount of bytes the actual + data is shifted compared to the base address of + the coarray. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number; zero indicates the current + image when used noncoindexed. + OLD intent(out) The value which the atomic variable + had just before the cas operation. + COMPARE intent(in) The value used for comparision. + NEW_VAL intent(in) The new value for the atomic + variable, assigned to the atomic variable, if + 'compare' equals the value of the atomic + variable. + STAT intent(out) Stores the status STAT= and may be + NULL. + TYPE intent(in) the data type, i.e. 'BT_INTEGER' (1) + or 'BT_LOGICAL' (2). + KIND intent(in) The kind value (only 4; always 'int') File: gfortran.info, Node: _gfortran_caf_atomic_op, Next: _gfortran_caf_co_broadcast, Prev: _gfortran_caf_atomic_cas, Up: Function ABI Documentation -8.2.23 `_gfortran_caf_atomic_op' -- Atomic operation +8.2.31 '_gfortran_caf_atomic_op' -- Atomic operation ---------------------------------------------------- _Description_: Apply an operation atomically to an atomic integer or logical variable. After the operation, OLD contains the value just before the operation, which, respectively, adds (GFC_CAF_ATOMIC_ADD) - atomically the `value' to the atomic integer variable or does a - bitwise AND, OR or exclusive OR of the between the atomic variable - and VALUE; the result is then stored in the atomic variable. + atomically the 'value' to the atomic integer variable or does a + bitwise AND, OR or exclusive OR between the atomic variable and + VALUE; the result is then stored in the atomic variable. _Syntax_: - `void _gfortran_caf_atomic_op (int op, caf_token_t token, size_t + 'void _gfortran_caf_atomic_op (int op, caf_token_t token, size_t offset, int image_index, void *value, void *old, int *stat, int type, int kind)' _Arguments_: - OP the operation to be performed; possible values - `GFC_CAF_ATOMIC_ADD' (1), `GFC_CAF_ATOMIC_AND' - (2), `GFC_CAF_ATOMIC_OR' (3), - `GFC_CAF_ATOMIC_XOR' (4). - TOKEN intent(in) An opaque pointer identifying the - coarray. - OFFSET By which amount of bytes the actual data is - shifted compared to the base address of the - coarray. - IMAGE_INDEXThe ID of the remote image; must be a positive - number; zero indicates the current image when - used noncoindexed. - OLD intent(out) the value which the atomic - variable had just before the atomic operation. - VAL intent(in) The new value for the atomic - variable, assigned to the atomic variable, if - `compare' equals the value of the atomic - variable. - STAT intent(out) Stores the status STAT= and may be - NULL. - TYPE the data type, i.e. `BT_INTEGER' (1) or - `BT_LOGICAL' (2). - KIND The kind value (only 4; always `int') + OP intent(in) the operation to be performed; + possible values 'GFC_CAF_ATOMIC_ADD' (1), + 'GFC_CAF_ATOMIC_AND' (2), 'GFC_CAF_ATOMIC_OR' + (3), 'GFC_CAF_ATOMIC_XOR' (4). + TOKEN intent(in) An opaque pointer identifying the + coarray. + OFFSET intent(in) By which amount of bytes the actual + data is shifted compared to the base address of + the coarray. + IMAGE_INDEX intent(in) The ID of the remote image; must be a + positive number; zero indicates the current + image when used noncoindexed. + OLD intent(out) The value which the atomic variable + had just before the atomic operation. + VAL intent(in) The new value for the atomic + variable, assigned to the atomic variable, if + 'compare' equals the value of the atomic + variable. + STAT intent(out) Stores the status STAT= and may be + NULL. + TYPE intent(in) the data type, i.e. 'BT_INTEGER' (1) + or 'BT_LOGICAL' (2) + KIND intent(in) the kind value (only 4; always 'int') File: gfortran.info, Node: _gfortran_caf_co_broadcast, Next: _gfortran_caf_co_max, Prev: _gfortran_caf_atomic_op, Up: Function ABI Documentation -8.2.24 `_gfortran_caf_co_broadcast' -- Sending data to all images +8.2.32 '_gfortran_caf_co_broadcast' -- Sending data to all images ----------------------------------------------------------------- _Description_: Distribute a value from a given image to all other images in the - team. Has to be called collectively. + team. Has to be called collectively. _Syntax_: - `void _gfortran_caf_co_broadcast (gfc_descriptor_t *a, int + 'void _gfortran_caf_co_broadcast (gfc_descriptor_t *a, int source_image, int *stat, char *errmsg, int errmsg_len)' _Arguments_: - A intent(inout) And array descriptor with the - data to be breoadcasted (on SOURCE_IMAGE) or - to be received (other images). - SOURCE_IMAGEThe ID of the image from which the data should - be taken. - STAT intent(out) Stores the status STAT= and may be - NULL. - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + A intent(inout) An array descriptor with the data + to be broadcasted (on SOURCE_IMAGE) or to be + received (other images). + SOURCE_IMAGEintent(in) The ID of the image from which the + data should be broadcasted. + STAT intent(out) Stores the status STAT= and may be + NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + ERRMSG_LEN intent(in) the buffer size of errmsg. File: gfortran.info, Node: _gfortran_caf_co_max, Next: _gfortran_caf_co_min, Prev: _gfortran_caf_co_broadcast, Up: Function ABI Documentation -8.2.25 `_gfortran_caf_co_max' -- Collective maximum reduction +8.2.33 '_gfortran_caf_co_max' -- Collective maximum reduction ------------------------------------------------------------- _Description_: - Calculates the for the each array element of the variable A the - maximum value for that element in the current team; if - RESULT_IMAGE has the value 0, the result shall be stored on all - images, otherwise, only on the specified image. This function - operates on numeric values and character strings. + Calculates for each array element of the variable A the maximum + value for that element in the current team; if RESULT_IMAGE has the + value 0, the result shall be stored on all images, otherwise, only + on the specified image. This function operates on numeric values + and character strings. _Syntax_: - `void _gfortran_caf_co_max (gfc_descriptor_t *a, int result_image, + 'void _gfortran_caf_co_max (gfc_descriptor_t *a, int result_image, int *stat, char *errmsg, int a_len, int errmsg_len)' _Arguments_: - A intent(inout) And array descriptor with the - data to be breoadcasted (on SOURCE_IMAGE) or - to be received (other images). - RESULT_IMAGEThe ID of the image to which the reduced value - should be copied to; if zero, it has to be - copied to all images. - STAT intent(out) Stores the status STAT= and may be - NULL. - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - A_LEN The string length of argument A. - ERRMSG_LEN the buffer size of errmsg. + A intent(inout) An array descriptor for the data + to be processed. On the destination image(s) + the result overwrites the old content. + RESULT_IMAGEintent(in) The ID of the image to which the + reduced value should be copied to; if zero, it + has to be copied to all images. + STAT intent(out) Stores the status STAT= and may be + NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + A_LEN intent(in) the string length of argument A + ERRMSG_LEN intent(in) the buffer size of errmsg _NOTES_ - If RESULT_IMAGE is nonzero, the value on all images except of the - specified one become undefined; hence, the library may make use of - this. + If RESULT_IMAGE is nonzero, the data in the array descriptor A on + all images except of the specified one become undefined; hence, the + library may make use of this. File: gfortran.info, Node: _gfortran_caf_co_min, Next: _gfortran_caf_co_sum, Prev: _gfortran_caf_co_max, Up: Function ABI Documentation -8.2.26 `_gfortran_caf_co_min' -- Collective minimum reduction +8.2.34 '_gfortran_caf_co_min' -- Collective minimum reduction ------------------------------------------------------------- _Description_: - Calculates the for the each array element of the variable A the - minimum value for that element in the current team; if - RESULT_IMAGE has the value 0, the result shall be stored on all - images, otherwise, only on the specified image. This function - operates on numeric values and character strings. + Calculates for each array element of the variable A the minimum + value for that element in the current team; if RESULT_IMAGE has the + value 0, the result shall be stored on all images, otherwise, only + on the specified image. This function operates on numeric values + and character strings. _Syntax_: - `void _gfortran_caf_co_min (gfc_descriptor_t *a, int result_image, + 'void _gfortran_caf_co_min (gfc_descriptor_t *a, int result_image, int *stat, char *errmsg, int a_len, int errmsg_len)' _Arguments_: - A intent(inout) And array descriptor with the - data to be breoadcasted (on SOURCE_IMAGE) or - to be received (other images). - RESULT_IMAGEThe ID of the image to which the reduced value - should be copied to; if zero, it has to be - copied to all images. - STAT intent(out) Stores the status STAT= and may be - NULL. - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - A_LEN The string length of argument A. - ERRMSG_LEN the buffer size of errmsg. + A intent(inout) An array descriptor for the data + to be processed. On the destination image(s) + the result overwrites the old content. + RESULT_IMAGEintent(in) The ID of the image to which the + reduced value should be copied to; if zero, it + has to be copied to all images. + STAT intent(out) Stores the status STAT= and may be + NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + A_LEN intent(in) the string length of argument A + ERRMSG_LEN intent(in) the buffer size of errmsg _NOTES_ - If RESULT_IMAGE is nonzero, the value on all images except of the - specified one become undefined; hence, the library may make use of - this. + If RESULT_IMAGE is nonzero, the data in the array descriptor A on + all images except of the specified one become undefined; hence, the + library may make use of this. File: gfortran.info, Node: _gfortran_caf_co_sum, Next: _gfortran_caf_co_reduce, Prev: _gfortran_caf_co_min, Up: Function ABI Documentation -8.2.27 `_gfortran_caf_co_sum' -- Collective summing reduction +8.2.35 '_gfortran_caf_co_sum' -- Collective summing reduction ------------------------------------------------------------- _Description_: - Calculates the for the each array element of the variable A the sum - value for that element in the current team; if RESULT_IMAGE has the - value 0, the result shall be stored on all images, otherwise, only - on the specified image. This function operates on numeric values. + Calculates for each array element of the variable A the sum of all + values for that element in the current team; if RESULT_IMAGE has + the value 0, the result shall be stored on all images, otherwise, + only on the specified image. This function operates on numeric + values only. _Syntax_: - `void _gfortran_caf_co_sum (gfc_descriptor_t *a, int result_image, + 'void _gfortran_caf_co_sum (gfc_descriptor_t *a, int result_image, int *stat, char *errmsg, int errmsg_len)' _Arguments_: - A intent(inout) And array descriptor with the - data to be breoadcasted (on SOURCE_IMAGE) or - to be received (other images). - RESULT_IMAGEThe ID of the image to which the reduced value - should be copied to; if zero, it has to be - copied to all images. - STAT intent(out) Stores the status STAT= and may be - NULL. - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - ERRMSG_LEN the buffer size of errmsg. + A intent(inout) An array descriptor with the data + to be processed. On the destination image(s) + the result overwrites the old content. + RESULT_IMAGEintent(in) The ID of the image to which the + reduced value should be copied to; if zero, it + has to be copied to all images. + STAT intent(out) Stores the status STAT= and may be + NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + ERRMSG_LEN intent(in) the buffer size of errmsg _NOTES_ - If RESULT_IMAGE is nonzero, the value on all images except of the - specified one become undefined; hence, the library may make use of - this. + If RESULT_IMAGE is nonzero, the data in the array descriptor A on + all images except of the specified one become undefined; hence, the + library may make use of this. File: gfortran.info, Node: _gfortran_caf_co_reduce, Prev: _gfortran_caf_co_sum, Up: Function ABI Documentation -8.2.28 `_gfortran_caf_co_reduce' -- Generic collective reduction +8.2.36 '_gfortran_caf_co_reduce' -- Generic collective reduction ---------------------------------------------------------------- _Description_: - Calculates the for the each array element of the variable A the - reduction value for that element in the current team; if - RESULT_IMAGE has the value 0, the result shall be stored on all - images, otherwise, only on the specified image. The OPR is a pure - function doing a mathematically commutative and associative - operation. + Calculates for each array element of the variable A the reduction + value for that element in the current team; if RESULT_IMAGE has the + value 0, the result shall be stored on all images, otherwise, only + on the specified image. The OPR is a pure function doing a + mathematically commutative and associative operation. The OPR_FLAGS denote the following; the values are bitwise ored. - `GFC_CAF_BYREF' (1) if the result should be returned by value; - `GFC_CAF_HIDDENLEN' (2) whether the result and argument string - lengths shall be specified as hidden argument; `GFC_CAF_ARG_VALUE' + 'GFC_CAF_BYREF' (1) if the result should be returned by reference; + 'GFC_CAF_HIDDENLEN' (2) whether the result and argument string + lengths shall be specified as hidden arguments; 'GFC_CAF_ARG_VALUE' (4) whether the arguments shall be passed by value, - `GFC_CAF_ARG_DESC' (8) whether the arguments shall be passed by + 'GFC_CAF_ARG_DESC' (8) whether the arguments shall be passed by descriptor. _Syntax_: - `void _gfortran_caf_co_reduce (gfc_descriptor_t *a, void * (*opr) + 'void _gfortran_caf_co_reduce (gfc_descriptor_t *a, void * (*opr) (void *, void *), int opr_flags, int result_image, int *stat, char *errmsg, int a_len, int errmsg_len)' _Arguments_: - OPR Function pointer to the reduction function. - OPR_FLAGS Flags regarding the reduction function - A intent(inout) And array descriptor with the - data to be breoadcasted (on SOURCE_IMAGE) or - to be received (other images). - RESULT_IMAGEThe ID of the image to which the reduced value - should be copied to; if zero, it has to be - copied to all images. - STAT intent(out) Stores the status STAT= and may be - NULL. - ERRMSG intent(out) When an error occurs, this will be - set to an error message; may be NULL - A_LEN The string length of argument A. - ERRMSG_LEN the buffer size of errmsg. + A intent(inout) An array descriptor with the data + to be processed. On the destination image(s) + the result overwrites the old content. + OPR intent(in) Function pointer to the reduction + function + OPR_FLAGS intent(in) Flags regarding the reduction + function + RESULT_IMAGEintent(in) The ID of the image to which the + reduced value should be copied to; if zero, it + has to be copied to all images. + STAT intent(out) Stores the status STAT= and may be + NULL. + ERRMSG intent(out) When an error occurs, this will be + set to an error message; may be NULL. + A_LEN intent(in) the string length of argument A + ERRMSG_LEN intent(in) the buffer size of errmsg _NOTES_ - If RESULT_IMAGE is nonzero, the value on all images except of the - specified one become undefined; hence, the library may make use of - this. For character arguments, the result is passed as first - argument, followed by the result string length, next come the two - string arguments, followed by the two hidden arguments. With C - binding, there are no hidden arguments and by-reference passing - and either only a single character is passed or an array + If RESULT_IMAGE is nonzero, the data in the array descriptor A on + all images except of the specified one become undefined; hence, the + library may make use of this. + + For character arguments, the result is passed as first argument, + followed by the result string length, next come the two string + arguments, followed by the two hidden string length arguments. + With C binding, there are no hidden arguments and by-reference + passing and either only a single character is passed or an array descriptor. @@ -5557,277 +6412,286 @@ File: gfortran.info, Node: Intrinsic Procedures, Next: Intrinsic Modules, Pre * Menu: * Introduction: Introduction to Intrinsics -* `ABORT': ABORT, Abort the program -* `ABS': ABS, Absolute value -* `ACCESS': ACCESS, Checks file access modes -* `ACHAR': ACHAR, Character in ASCII collating sequence -* `ACOS': ACOS, Arccosine function -* `ACOSH': ACOSH, Inverse hyperbolic cosine function -* `ADJUSTL': ADJUSTL, Left adjust a string -* `ADJUSTR': ADJUSTR, Right adjust a string -* `AIMAG': AIMAG, Imaginary part of complex number -* `AINT': AINT, Truncate to a whole number -* `ALARM': ALARM, Set an alarm clock -* `ALL': ALL, Determine if all values are true -* `ALLOCATED': ALLOCATED, Status of allocatable entity -* `AND': AND, Bitwise logical AND -* `ANINT': ANINT, Nearest whole number -* `ANY': ANY, Determine if any values are true -* `ASIN': ASIN, Arcsine function -* `ASINH': ASINH, Inverse hyperbolic sine function -* `ASSOCIATED': ASSOCIATED, Status of a pointer or pointer/target pair -* `ATAN': ATAN, Arctangent function -* `ATAN2': ATAN2, Arctangent function -* `ATANH': ATANH, Inverse hyperbolic tangent function -* `ATOMIC_ADD': ATOMIC_ADD, Atomic ADD operation -* `ATOMIC_AND': ATOMIC_AND, Atomic bitwise AND operation -* `ATOMIC_CAS': ATOMIC_CAS, Atomic compare and swap -* `ATOMIC_DEFINE': ATOMIC_DEFINE, Setting a variable atomically -* `ATOMIC_FETCH_ADD': ATOMIC_FETCH_ADD, Atomic ADD operation with prior fetch -* `ATOMIC_FETCH_AND': ATOMIC_FETCH_AND, Atomic bitwise AND operation with prior fetch -* `ATOMIC_FETCH_OR': ATOMIC_FETCH_OR, Atomic bitwise OR operation with prior fetch -* `ATOMIC_FETCH_XOR': ATOMIC_FETCH_XOR, Atomic bitwise XOR operation with prior fetch -* `ATOMIC_OR': ATOMIC_OR, Atomic bitwise OR operation -* `ATOMIC_REF': ATOMIC_REF, Obtaining the value of a variable atomically -* `ATOMIC_XOR': ATOMIC_XOR, Atomic bitwise OR operation -* `BACKTRACE': BACKTRACE, Show a backtrace -* `BESSEL_J0': BESSEL_J0, Bessel function of the first kind of order 0 -* `BESSEL_J1': BESSEL_J1, Bessel function of the first kind of order 1 -* `BESSEL_JN': BESSEL_JN, Bessel function of the first kind -* `BESSEL_Y0': BESSEL_Y0, Bessel function of the second kind of order 0 -* `BESSEL_Y1': BESSEL_Y1, Bessel function of the second kind of order 1 -* `BESSEL_YN': BESSEL_YN, Bessel function of the second kind -* `BGE': BGE, Bitwise greater than or equal to -* `BGT': BGT, Bitwise greater than -* `BIT_SIZE': BIT_SIZE, Bit size inquiry function -* `BLE': BLE, Bitwise less than or equal to -* `BLT': BLT, Bitwise less than -* `BTEST': BTEST, Bit test function -* `C_ASSOCIATED': C_ASSOCIATED, Status of a C pointer -* `C_F_POINTER': C_F_POINTER, Convert C into Fortran pointer -* `C_F_PROCPOINTER': C_F_PROCPOINTER, Convert C into Fortran procedure pointer -* `C_FUNLOC': C_FUNLOC, Obtain the C address of a procedure -* `C_LOC': C_LOC, Obtain the C address of an object -* `C_SIZEOF': C_SIZEOF, Size in bytes of an expression -* `CEILING': CEILING, Integer ceiling function -* `CHAR': CHAR, Integer-to-character conversion function -* `CHDIR': CHDIR, Change working directory -* `CHMOD': CHMOD, Change access permissions of files -* `CMPLX': CMPLX, Complex conversion function -* `CO_BROADCAST': CO_BROADCAST, Copy a value to all images the current set of images -* `CO_MAX': CO_MAX, Maximal value on the current set of images -* `CO_MIN': CO_MIN, Minimal value on the current set of images -* `CO_REDUCE': CO_REDUCE, Reduction of values on the current set of images -* `CO_SUM': CO_SUM, Sum of values on the current set of images -* `COMMAND_ARGUMENT_COUNT': COMMAND_ARGUMENT_COUNT, Get number of command line arguments -* `COMPILER_OPTIONS': COMPILER_OPTIONS, Options passed to the compiler -* `COMPILER_VERSION': COMPILER_VERSION, Compiler version string -* `COMPLEX': COMPLEX, Complex conversion function -* `CONJG': CONJG, Complex conjugate function -* `COS': COS, Cosine function -* `COSH': COSH, Hyperbolic cosine function -* `COUNT': COUNT, Count occurrences of TRUE in an array -* `CPU_TIME': CPU_TIME, CPU time subroutine -* `CSHIFT': CSHIFT, Circular shift elements of an array -* `CTIME': CTIME, Subroutine (or function) to convert a time into a string -* `DATE_AND_TIME': DATE_AND_TIME, Date and time subroutine -* `DBLE': DBLE, Double precision conversion function -* `DCMPLX': DCMPLX, Double complex conversion function -* `DIGITS': DIGITS, Significant digits function -* `DIM': DIM, Positive difference -* `DOT_PRODUCT': DOT_PRODUCT, Dot product function -* `DPROD': DPROD, Double product function -* `DREAL': DREAL, Double real part function -* `DSHIFTL': DSHIFTL, Combined left shift -* `DSHIFTR': DSHIFTR, Combined right shift -* `DTIME': DTIME, Execution time subroutine (or function) -* `EOSHIFT': EOSHIFT, End-off shift elements of an array -* `EPSILON': EPSILON, Epsilon function -* `ERF': ERF, Error function -* `ERFC': ERFC, Complementary error function -* `ERFC_SCALED': ERFC_SCALED, Exponentially-scaled complementary error function -* `ETIME': ETIME, Execution time subroutine (or function) -* `EVENT_QUERY': EVENT_QUERY, Query whether a coarray event has occurred -* `EXECUTE_COMMAND_LINE': EXECUTE_COMMAND_LINE, Execute a shell command -* `EXIT': EXIT, Exit the program with status. -* `EXP': EXP, Exponential function -* `EXPONENT': EXPONENT, Exponent function -* `EXTENDS_TYPE_OF': EXTENDS_TYPE_OF, Query dynamic type for extension -* `FDATE': FDATE, Subroutine (or function) to get the current time as a string -* `FGET': FGET, Read a single character in stream mode from stdin -* `FGETC': FGETC, Read a single character in stream mode -* `FLOOR': FLOOR, Integer floor function -* `FLUSH': FLUSH, Flush I/O unit(s) -* `FNUM': FNUM, File number function -* `FPUT': FPUT, Write a single character in stream mode to stdout -* `FPUTC': FPUTC, Write a single character in stream mode -* `FRACTION': FRACTION, Fractional part of the model representation -* `FREE': FREE, Memory de-allocation subroutine -* `FSEEK': FSEEK, Low level file positioning subroutine -* `FSTAT': FSTAT, Get file status -* `FTELL': FTELL, Current stream position -* `GAMMA': GAMMA, Gamma function -* `GERROR': GERROR, Get last system error message -* `GETARG': GETARG, Get command line arguments -* `GET_COMMAND': GET_COMMAND, Get the entire command line -* `GET_COMMAND_ARGUMENT': GET_COMMAND_ARGUMENT, Get command line arguments -* `GETCWD': GETCWD, Get current working directory -* `GETENV': GETENV, Get an environmental variable -* `GET_ENVIRONMENT_VARIABLE': GET_ENVIRONMENT_VARIABLE, Get an environmental variable -* `GETGID': GETGID, Group ID function -* `GETLOG': GETLOG, Get login name -* `GETPID': GETPID, Process ID function -* `GETUID': GETUID, User ID function -* `GMTIME': GMTIME, Convert time to GMT info -* `HOSTNM': HOSTNM, Get system host name -* `HUGE': HUGE, Largest number of a kind -* `HYPOT': HYPOT, Euclidean distance function -* `IACHAR': IACHAR, Code in ASCII collating sequence -* `IALL': IALL, Bitwise AND of array elements -* `IAND': IAND, Bitwise logical and -* `IANY': IANY, Bitwise OR of array elements -* `IARGC': IARGC, Get the number of command line arguments -* `IBCLR': IBCLR, Clear bit -* `IBITS': IBITS, Bit extraction -* `IBSET': IBSET, Set bit -* `ICHAR': ICHAR, Character-to-integer conversion function -* `IDATE': IDATE, Current local time (day/month/year) -* `IEOR': IEOR, Bitwise logical exclusive or -* `IERRNO': IERRNO, Function to get the last system error number -* `IMAGE_INDEX': IMAGE_INDEX, Cosubscript to image index conversion -* `INDEX': INDEX intrinsic, Position of a substring within a string -* `INT': INT, Convert to integer type -* `INT2': INT2, Convert to 16-bit integer type -* `INT8': INT8, Convert to 64-bit integer type -* `IOR': IOR, Bitwise logical or -* `IPARITY': IPARITY, Bitwise XOR of array elements -* `IRAND': IRAND, Integer pseudo-random number -* `IS_IOSTAT_END': IS_IOSTAT_END, Test for end-of-file value -* `IS_IOSTAT_EOR': IS_IOSTAT_EOR, Test for end-of-record value -* `ISATTY': ISATTY, Whether a unit is a terminal device -* `ISHFT': ISHFT, Shift bits -* `ISHFTC': ISHFTC, Shift bits circularly -* `ISNAN': ISNAN, Tests for a NaN -* `ITIME': ITIME, Current local time (hour/minutes/seconds) -* `KILL': KILL, Send a signal to a process -* `KIND': KIND, Kind of an entity -* `LBOUND': LBOUND, Lower dimension bounds of an array -* `LCOBOUND': LCOBOUND, Lower codimension bounds of an array -* `LEADZ': LEADZ, Number of leading zero bits of an integer -* `LEN': LEN, Length of a character entity -* `LEN_TRIM': LEN_TRIM, Length of a character entity without trailing blank characters -* `LGE': LGE, Lexical greater than or equal -* `LGT': LGT, Lexical greater than -* `LINK': LINK, Create a hard link -* `LLE': LLE, Lexical less than or equal -* `LLT': LLT, Lexical less than -* `LNBLNK': LNBLNK, Index of the last non-blank character in a string -* `LOC': LOC, Returns the address of a variable -* `LOG': LOG, Logarithm function -* `LOG10': LOG10, Base 10 logarithm function -* `LOG_GAMMA': LOG_GAMMA, Logarithm of the Gamma function -* `LOGICAL': LOGICAL, Convert to logical type -* `LONG': LONG, Convert to integer type -* `LSHIFT': LSHIFT, Left shift bits -* `LSTAT': LSTAT, Get file status -* `LTIME': LTIME, Convert time to local time info -* `MALLOC': MALLOC, Dynamic memory allocation function -* `MASKL': MASKL, Left justified mask -* `MASKR': MASKR, Right justified mask -* `MATMUL': MATMUL, matrix multiplication -* `MAX': MAX, Maximum value of an argument list -* `MAXEXPONENT': MAXEXPONENT, Maximum exponent of a real kind -* `MAXLOC': MAXLOC, Location of the maximum value within an array -* `MAXVAL': MAXVAL, Maximum value of an array -* `MCLOCK': MCLOCK, Time function -* `MCLOCK8': MCLOCK8, Time function (64-bit) -* `MERGE': MERGE, Merge arrays -* `MERGE_BITS': MERGE_BITS, Merge of bits under mask -* `MIN': MIN, Minimum value of an argument list -* `MINEXPONENT': MINEXPONENT, Minimum exponent of a real kind -* `MINLOC': MINLOC, Location of the minimum value within an array -* `MINVAL': MINVAL, Minimum value of an array -* `MOD': MOD, Remainder function -* `MODULO': MODULO, Modulo function -* `MOVE_ALLOC': MOVE_ALLOC, Move allocation from one object to another -* `MVBITS': MVBITS, Move bits from one integer to another -* `NEAREST': NEAREST, Nearest representable number -* `NEW_LINE': NEW_LINE, New line character -* `NINT': NINT, Nearest whole number -* `NORM2': NORM2, Euclidean vector norm -* `NOT': NOT, Logical negation -* `NULL': NULL, Function that returns an disassociated pointer -* `NUM_IMAGES': NUM_IMAGES, Number of images -* `OR': OR, Bitwise logical OR -* `PACK': PACK, Pack an array into an array of rank one -* `PARITY': PARITY, Reduction with exclusive OR -* `PERROR': PERROR, Print system error message -* `POPCNT': POPCNT, Number of bits set -* `POPPAR': POPPAR, Parity of the number of bits set -* `PRECISION': PRECISION, Decimal precision of a real kind -* `PRESENT': PRESENT, Determine whether an optional dummy argument is specified -* `PRODUCT': PRODUCT, Product of array elements -* `RADIX': RADIX, Base of a data model -* `RAN': RAN, Real pseudo-random number -* `RAND': RAND, Real pseudo-random number -* `RANDOM_NUMBER': RANDOM_NUMBER, Pseudo-random number -* `RANDOM_SEED': RANDOM_SEED, Initialize a pseudo-random number sequence -* `RANGE': RANGE, Decimal exponent range -* `RANK' : RANK, Rank of a data object -* `REAL': REAL, Convert to real type -* `RENAME': RENAME, Rename a file -* `REPEAT': REPEAT, Repeated string concatenation -* `RESHAPE': RESHAPE, Function to reshape an array -* `RRSPACING': RRSPACING, Reciprocal of the relative spacing -* `RSHIFT': RSHIFT, Right shift bits -* `SAME_TYPE_AS': SAME_TYPE_AS, Query dynamic types for equality -* `SCALE': SCALE, Scale a real value -* `SCAN': SCAN, Scan a string for the presence of a set of characters -* `SECNDS': SECNDS, Time function -* `SECOND': SECOND, CPU time function -* `SELECTED_CHAR_KIND': SELECTED_CHAR_KIND, Choose character kind -* `SELECTED_INT_KIND': SELECTED_INT_KIND, Choose integer kind -* `SELECTED_REAL_KIND': SELECTED_REAL_KIND, Choose real kind -* `SET_EXPONENT': SET_EXPONENT, Set the exponent of the model -* `SHAPE': SHAPE, Determine the shape of an array -* `SHIFTA': SHIFTA, Right shift with fill -* `SHIFTL': SHIFTL, Left shift -* `SHIFTR': SHIFTR, Right shift -* `SIGN': SIGN, Sign copying function -* `SIGNAL': SIGNAL, Signal handling subroutine (or function) -* `SIN': SIN, Sine function -* `SINH': SINH, Hyperbolic sine function -* `SIZE': SIZE, Function to determine the size of an array -* `SIZEOF': SIZEOF, Determine the size in bytes of an expression -* `SLEEP': SLEEP, Sleep for the specified number of seconds -* `SPACING': SPACING, Smallest distance between two numbers of a given type -* `SPREAD': SPREAD, Add a dimension to an array -* `SQRT': SQRT, Square-root function -* `SRAND': SRAND, Reinitialize the random number generator -* `STAT': STAT, Get file status -* `STORAGE_SIZE': STORAGE_SIZE, Storage size in bits -* `SUM': SUM, Sum of array elements -* `SYMLNK': SYMLNK, Create a symbolic link -* `SYSTEM': SYSTEM, Execute a shell command -* `SYSTEM_CLOCK': SYSTEM_CLOCK, Time function -* `TAN': TAN, Tangent function -* `TANH': TANH, Hyperbolic tangent function -* `THIS_IMAGE': THIS_IMAGE, Cosubscript index of this image -* `TIME': TIME, Time function -* `TIME8': TIME8, Time function (64-bit) -* `TINY': TINY, Smallest positive number of a real kind -* `TRAILZ': TRAILZ, Number of trailing zero bits of an integer -* `TRANSFER': TRANSFER, Transfer bit patterns -* `TRANSPOSE': TRANSPOSE, Transpose an array of rank two -* `TRIM': TRIM, Remove trailing blank characters of a string -* `TTYNAM': TTYNAM, Get the name of a terminal device. -* `UBOUND': UBOUND, Upper dimension bounds of an array -* `UCOBOUND': UCOBOUND, Upper codimension bounds of an array -* `UMASK': UMASK, Set the file creation mask -* `UNLINK': UNLINK, Remove a file from the file system -* `UNPACK': UNPACK, Unpack an array of rank one into an array -* `VERIFY': VERIFY, Scan a string for the absence of a set of characters -* `XOR': XOR, Bitwise logical exclusive or +* 'ABORT': ABORT, Abort the program +* 'ABS': ABS, Absolute value +* 'ACCESS': ACCESS, Checks file access modes +* 'ACHAR': ACHAR, Character in ASCII collating sequence +* 'ACOS': ACOS, Arccosine function +* 'ACOSD': ACOSD, Arccosine function, degrees +* 'ACOSH': ACOSH, Inverse hyperbolic cosine function +* 'ADJUSTL': ADJUSTL, Left adjust a string +* 'ADJUSTR': ADJUSTR, Right adjust a string +* 'AIMAG': AIMAG, Imaginary part of complex number +* 'AINT': AINT, Truncate to a whole number +* 'ALARM': ALARM, Set an alarm clock +* 'ALL': ALL, Determine if all values are true +* 'ALLOCATED': ALLOCATED, Status of allocatable entity +* 'AND': AND, Bitwise logical AND +* 'ANINT': ANINT, Nearest whole number +* 'ANY': ANY, Determine if any values are true +* 'ASIN': ASIN, Arcsine function +* 'ASIND': ASIND, Arcsine function, degrees +* 'ASINH': ASINH, Inverse hyperbolic sine function +* 'ASSOCIATED': ASSOCIATED, Status of a pointer or pointer/target pair +* 'ATAN': ATAN, Arctangent function +* 'ATAND': ATAND, Arctangent function, degrees +* 'ATAN2': ATAN2, Arctangent function +* 'ATAN2D': ATAN2D, Arctangent function, degrees +* 'ATANH': ATANH, Inverse hyperbolic tangent function +* 'ATOMIC_ADD': ATOMIC_ADD, Atomic ADD operation +* 'ATOMIC_AND': ATOMIC_AND, Atomic bitwise AND operation +* 'ATOMIC_CAS': ATOMIC_CAS, Atomic compare and swap +* 'ATOMIC_DEFINE': ATOMIC_DEFINE, Setting a variable atomically +* 'ATOMIC_FETCH_ADD': ATOMIC_FETCH_ADD, Atomic ADD operation with prior fetch +* 'ATOMIC_FETCH_AND': ATOMIC_FETCH_AND, Atomic bitwise AND operation with prior fetch +* 'ATOMIC_FETCH_OR': ATOMIC_FETCH_OR, Atomic bitwise OR operation with prior fetch +* 'ATOMIC_FETCH_XOR': ATOMIC_FETCH_XOR, Atomic bitwise XOR operation with prior fetch +* 'ATOMIC_OR': ATOMIC_OR, Atomic bitwise OR operation +* 'ATOMIC_REF': ATOMIC_REF, Obtaining the value of a variable atomically +* 'ATOMIC_XOR': ATOMIC_XOR, Atomic bitwise OR operation +* 'BACKTRACE': BACKTRACE, Show a backtrace +* 'BESSEL_J0': BESSEL_J0, Bessel function of the first kind of order 0 +* 'BESSEL_J1': BESSEL_J1, Bessel function of the first kind of order 1 +* 'BESSEL_JN': BESSEL_JN, Bessel function of the first kind +* 'BESSEL_Y0': BESSEL_Y0, Bessel function of the second kind of order 0 +* 'BESSEL_Y1': BESSEL_Y1, Bessel function of the second kind of order 1 +* 'BESSEL_YN': BESSEL_YN, Bessel function of the second kind +* 'BGE': BGE, Bitwise greater than or equal to +* 'BGT': BGT, Bitwise greater than +* 'BIT_SIZE': BIT_SIZE, Bit size inquiry function +* 'BLE': BLE, Bitwise less than or equal to +* 'BLT': BLT, Bitwise less than +* 'BTEST': BTEST, Bit test function +* 'C_ASSOCIATED': C_ASSOCIATED, Status of a C pointer +* 'C_F_POINTER': C_F_POINTER, Convert C into Fortran pointer +* 'C_F_PROCPOINTER': C_F_PROCPOINTER, Convert C into Fortran procedure pointer +* 'C_FUNLOC': C_FUNLOC, Obtain the C address of a procedure +* 'C_LOC': C_LOC, Obtain the C address of an object +* 'C_SIZEOF': C_SIZEOF, Size in bytes of an expression +* 'CEILING': CEILING, Integer ceiling function +* 'CHAR': CHAR, Integer-to-character conversion function +* 'CHDIR': CHDIR, Change working directory +* 'CHMOD': CHMOD, Change access permissions of files +* 'CMPLX': CMPLX, Complex conversion function +* 'CO_BROADCAST': CO_BROADCAST, Copy a value to all images the current set of images +* 'CO_MAX': CO_MAX, Maximal value on the current set of images +* 'CO_MIN': CO_MIN, Minimal value on the current set of images +* 'CO_REDUCE': CO_REDUCE, Reduction of values on the current set of images +* 'CO_SUM': CO_SUM, Sum of values on the current set of images +* 'COMMAND_ARGUMENT_COUNT': COMMAND_ARGUMENT_COUNT, Get number of command line arguments +* 'COMPILER_OPTIONS': COMPILER_OPTIONS, Options passed to the compiler +* 'COMPILER_VERSION': COMPILER_VERSION, Compiler version string +* 'COMPLEX': COMPLEX, Complex conversion function +* 'CONJG': CONJG, Complex conjugate function +* 'COS': COS, Cosine function +* 'COSD': COSD, Cosine function, degrees +* 'COSH': COSH, Hyperbolic cosine function +* 'COTAN': COTAN, Cotangent function +* 'COTAND': COTAND, Cotangent function, degrees +* 'COUNT': COUNT, Count occurrences of TRUE in an array +* 'CPU_TIME': CPU_TIME, CPU time subroutine +* 'CSHIFT': CSHIFT, Circular shift elements of an array +* 'CTIME': CTIME, Subroutine (or function) to convert a time into a string +* 'DATE_AND_TIME': DATE_AND_TIME, Date and time subroutine +* 'DBLE': DBLE, Double precision conversion function +* 'DCMPLX': DCMPLX, Double complex conversion function +* 'DIGITS': DIGITS, Significant digits function +* 'DIM': DIM, Positive difference +* 'DOT_PRODUCT': DOT_PRODUCT, Dot product function +* 'DPROD': DPROD, Double product function +* 'DREAL': DREAL, Double real part function +* 'DSHIFTL': DSHIFTL, Combined left shift +* 'DSHIFTR': DSHIFTR, Combined right shift +* 'DTIME': DTIME, Execution time subroutine (or function) +* 'EOSHIFT': EOSHIFT, End-off shift elements of an array +* 'EPSILON': EPSILON, Epsilon function +* 'ERF': ERF, Error function +* 'ERFC': ERFC, Complementary error function +* 'ERFC_SCALED': ERFC_SCALED, Exponentially-scaled complementary error function +* 'ETIME': ETIME, Execution time subroutine (or function) +* 'EVENT_QUERY': EVENT_QUERY, Query whether a coarray event has occurred +* 'EXECUTE_COMMAND_LINE': EXECUTE_COMMAND_LINE, Execute a shell command +* 'EXIT': EXIT, Exit the program with status. +* 'EXP': EXP, Exponential function +* 'EXPONENT': EXPONENT, Exponent function +* 'EXTENDS_TYPE_OF': EXTENDS_TYPE_OF, Query dynamic type for extension +* 'FDATE': FDATE, Subroutine (or function) to get the current time as a string +* 'FGET': FGET, Read a single character in stream mode from stdin +* 'FGETC': FGETC, Read a single character in stream mode +* 'FLOOR': FLOOR, Integer floor function +* 'FLUSH': FLUSH, Flush I/O unit(s) +* 'FNUM': FNUM, File number function +* 'FPUT': FPUT, Write a single character in stream mode to stdout +* 'FPUTC': FPUTC, Write a single character in stream mode +* 'FRACTION': FRACTION, Fractional part of the model representation +* 'FREE': FREE, Memory de-allocation subroutine +* 'FSEEK': FSEEK, Low level file positioning subroutine +* 'FSTAT': FSTAT, Get file status +* 'FTELL': FTELL, Current stream position +* 'GAMMA': GAMMA, Gamma function +* 'GERROR': GERROR, Get last system error message +* 'GETARG': GETARG, Get command line arguments +* 'GET_COMMAND': GET_COMMAND, Get the entire command line +* 'GET_COMMAND_ARGUMENT': GET_COMMAND_ARGUMENT, Get command line arguments +* 'GETCWD': GETCWD, Get current working directory +* 'GETENV': GETENV, Get an environmental variable +* 'GET_ENVIRONMENT_VARIABLE': GET_ENVIRONMENT_VARIABLE, Get an environmental variable +* 'GETGID': GETGID, Group ID function +* 'GETLOG': GETLOG, Get login name +* 'GETPID': GETPID, Process ID function +* 'GETUID': GETUID, User ID function +* 'GMTIME': GMTIME, Convert time to GMT info +* 'HOSTNM': HOSTNM, Get system host name +* 'HUGE': HUGE, Largest number of a kind +* 'HYPOT': HYPOT, Euclidean distance function +* 'IACHAR': IACHAR, Code in ASCII collating sequence +* 'IALL': IALL, Bitwise AND of array elements +* 'IAND': IAND, Bitwise logical and +* 'IANY': IANY, Bitwise OR of array elements +* 'IARGC': IARGC, Get the number of command line arguments +* 'IBCLR': IBCLR, Clear bit +* 'IBITS': IBITS, Bit extraction +* 'IBSET': IBSET, Set bit +* 'ICHAR': ICHAR, Character-to-integer conversion function +* 'IDATE': IDATE, Current local time (day/month/year) +* 'IEOR': IEOR, Bitwise logical exclusive or +* 'IERRNO': IERRNO, Function to get the last system error number +* 'IMAGE_INDEX': IMAGE_INDEX, Cosubscript to image index conversion +* 'INDEX': INDEX intrinsic, Position of a substring within a string +* 'INT': INT, Convert to integer type +* 'INT2': INT2, Convert to 16-bit integer type +* 'INT8': INT8, Convert to 64-bit integer type +* 'IOR': IOR, Bitwise logical or +* 'IPARITY': IPARITY, Bitwise XOR of array elements +* 'IRAND': IRAND, Integer pseudo-random number +* 'IS_IOSTAT_END': IS_IOSTAT_END, Test for end-of-file value +* 'IS_IOSTAT_EOR': IS_IOSTAT_EOR, Test for end-of-record value +* 'ISATTY': ISATTY, Whether a unit is a terminal device +* 'ISHFT': ISHFT, Shift bits +* 'ISHFTC': ISHFTC, Shift bits circularly +* 'ISNAN': ISNAN, Tests for a NaN +* 'ITIME': ITIME, Current local time (hour/minutes/seconds) +* 'KILL': KILL, Send a signal to a process +* 'KIND': KIND, Kind of an entity +* 'LBOUND': LBOUND, Lower dimension bounds of an array +* 'LCOBOUND': LCOBOUND, Lower codimension bounds of an array +* 'LEADZ': LEADZ, Number of leading zero bits of an integer +* 'LEN': LEN, Length of a character entity +* 'LEN_TRIM': LEN_TRIM, Length of a character entity without trailing blank characters +* 'LGE': LGE, Lexical greater than or equal +* 'LGT': LGT, Lexical greater than +* 'LINK': LINK, Create a hard link +* 'LLE': LLE, Lexical less than or equal +* 'LLT': LLT, Lexical less than +* 'LNBLNK': LNBLNK, Index of the last non-blank character in a string +* 'LOC': LOC, Returns the address of a variable +* 'LOG': LOG, Logarithm function +* 'LOG10': LOG10, Base 10 logarithm function +* 'LOG_GAMMA': LOG_GAMMA, Logarithm of the Gamma function +* 'LOGICAL': LOGICAL, Convert to logical type +* 'LONG': LONG, Convert to integer type +* 'LSHIFT': LSHIFT, Left shift bits +* 'LSTAT': LSTAT, Get file status +* 'LTIME': LTIME, Convert time to local time info +* 'MALLOC': MALLOC, Dynamic memory allocation function +* 'MASKL': MASKL, Left justified mask +* 'MASKR': MASKR, Right justified mask +* 'MATMUL': MATMUL, matrix multiplication +* 'MAX': MAX, Maximum value of an argument list +* 'MAXEXPONENT': MAXEXPONENT, Maximum exponent of a real kind +* 'MAXLOC': MAXLOC, Location of the maximum value within an array +* 'MAXVAL': MAXVAL, Maximum value of an array +* 'MCLOCK': MCLOCK, Time function +* 'MCLOCK8': MCLOCK8, Time function (64-bit) +* 'MERGE': MERGE, Merge arrays +* 'MERGE_BITS': MERGE_BITS, Merge of bits under mask +* 'MIN': MIN, Minimum value of an argument list +* 'MINEXPONENT': MINEXPONENT, Minimum exponent of a real kind +* 'MINLOC': MINLOC, Location of the minimum value within an array +* 'MINVAL': MINVAL, Minimum value of an array +* 'MOD': MOD, Remainder function +* 'MODULO': MODULO, Modulo function +* 'MOVE_ALLOC': MOVE_ALLOC, Move allocation from one object to another +* 'MVBITS': MVBITS, Move bits from one integer to another +* 'NEAREST': NEAREST, Nearest representable number +* 'NEW_LINE': NEW_LINE, New line character +* 'NINT': NINT, Nearest whole number +* 'NORM2': NORM2, Euclidean vector norm +* 'NOT': NOT, Logical negation +* 'NULL': NULL, Function that returns an disassociated pointer +* 'NUM_IMAGES': NUM_IMAGES, Number of images +* 'OR': OR, Bitwise logical OR +* 'PACK': PACK, Pack an array into an array of rank one +* 'PARITY': PARITY, Reduction with exclusive OR +* 'PERROR': PERROR, Print system error message +* 'POPCNT': POPCNT, Number of bits set +* 'POPPAR': POPPAR, Parity of the number of bits set +* 'PRECISION': PRECISION, Decimal precision of a real kind +* 'PRESENT': PRESENT, Determine whether an optional dummy argument is specified +* 'PRODUCT': PRODUCT, Product of array elements +* 'RADIX': RADIX, Base of a data model +* 'RAN': RAN, Real pseudo-random number +* 'RAND': RAND, Real pseudo-random number +* 'RANDOM_NUMBER': RANDOM_NUMBER, Pseudo-random number +* 'RANDOM_SEED': RANDOM_SEED, Initialize a pseudo-random number sequence +* 'RANGE': RANGE, Decimal exponent range +* 'RANK' : RANK, Rank of a data object +* 'REAL': REAL, Convert to real type +* 'RENAME': RENAME, Rename a file +* 'REPEAT': REPEAT, Repeated string concatenation +* 'RESHAPE': RESHAPE, Function to reshape an array +* 'RRSPACING': RRSPACING, Reciprocal of the relative spacing +* 'RSHIFT': RSHIFT, Right shift bits +* 'SAME_TYPE_AS': SAME_TYPE_AS, Query dynamic types for equality +* 'SCALE': SCALE, Scale a real value +* 'SCAN': SCAN, Scan a string for the presence of a set of characters +* 'SECNDS': SECNDS, Time function +* 'SECOND': SECOND, CPU time function +* 'SELECTED_CHAR_KIND': SELECTED_CHAR_KIND, Choose character kind +* 'SELECTED_INT_KIND': SELECTED_INT_KIND, Choose integer kind +* 'SELECTED_REAL_KIND': SELECTED_REAL_KIND, Choose real kind +* 'SET_EXPONENT': SET_EXPONENT, Set the exponent of the model +* 'SHAPE': SHAPE, Determine the shape of an array +* 'SHIFTA': SHIFTA, Right shift with fill +* 'SHIFTL': SHIFTL, Left shift +* 'SHIFTR': SHIFTR, Right shift +* 'SIGN': SIGN, Sign copying function +* 'SIGNAL': SIGNAL, Signal handling subroutine (or function) +* 'SIN': SIN, Sine function +* 'SIND': SIND, Sine function, degrees +* 'SINH': SINH, Hyperbolic sine function +* 'SIZE': SIZE, Function to determine the size of an array +* 'SIZEOF': SIZEOF, Determine the size in bytes of an expression +* 'SLEEP': SLEEP, Sleep for the specified number of seconds +* 'SPACING': SPACING, Smallest distance between two numbers of a given type +* 'SPREAD': SPREAD, Add a dimension to an array +* 'SQRT': SQRT, Square-root function +* 'SRAND': SRAND, Reinitialize the random number generator +* 'STAT': STAT, Get file status +* 'STORAGE_SIZE': STORAGE_SIZE, Storage size in bits +* 'SUM': SUM, Sum of array elements +* 'SYMLNK': SYMLNK, Create a symbolic link +* 'SYSTEM': SYSTEM, Execute a shell command +* 'SYSTEM_CLOCK': SYSTEM_CLOCK, Time function +* 'TAN': TAN, Tangent function +* 'TAND': TAND, Tangent function, degrees +* 'TANH': TANH, Hyperbolic tangent function +* 'THIS_IMAGE': THIS_IMAGE, Cosubscript index of this image +* 'TIME': TIME, Time function +* 'TIME8': TIME8, Time function (64-bit) +* 'TINY': TINY, Smallest positive number of a real kind +* 'TRAILZ': TRAILZ, Number of trailing zero bits of an integer +* 'TRANSFER': TRANSFER, Transfer bit patterns +* 'TRANSPOSE': TRANSPOSE, Transpose an array of rank two +* 'TRIM': TRIM, Remove trailing blank characters of a string +* 'TTYNAM': TTYNAM, Get the name of a terminal device. +* 'UBOUND': UBOUND, Upper dimension bounds of an array +* 'UCOBOUND': UCOBOUND, Upper codimension bounds of an array +* 'UMASK': UMASK, Set the file creation mask +* 'UNLINK': UNLINK, Remove a file from the file system +* 'UNPACK': UNPACK, Unpack an array of rank one into an array +* 'VERIFY': VERIFY, Scan a string for the absence of a set of characters +* 'XOR': XOR, Bitwise logical exclusive or File: gfortran.info, Node: Introduction to Intrinsics, Next: ABORT, Up: Intrinsic Procedures @@ -5844,44 +6708,44 @@ 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 enumeration of the `KIND' type parameter is processor defined in + The enumeration of the 'KIND' type parameter is processor defined in the Fortran 95 standard. GNU Fortran defines the default integer type -and default real type by `INTEGER(KIND=4)' and `REAL(KIND=4)', +and default real type by 'INTEGER(KIND=4)' and 'REAL(KIND=4)', respectively. The standard mandates that both data types shall have another kind, which have more precision. On typical target -architectures supported by `gfortran', this kind type parameter is -`KIND=8'. Hence, `REAL(KIND=8)' and `DOUBLE PRECISION' are equivalent. +architectures supported by 'gfortran', this kind type parameter is +'KIND=8'. Hence, 'REAL(KIND=8)' and 'DOUBLE PRECISION' are equivalent. In the description of generic intrinsic procedures, the kind type -parameter will be specified by `KIND=*', and in the description of +parameter will be specified by 'KIND=*', and in the description of specific names for an intrinsic procedure the kind type parameter will -be explicitly given (e.g., `REAL(KIND=4)' or `REAL(KIND=8)'). Finally, -for brevity the optional `KIND=' syntax will be omitted. +be explicitly given (e.g., 'REAL(KIND=4)' or 'REAL(KIND=8)'). Finally, +for brevity the optional 'KIND=' syntax will be omitted. 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 `-std=f95' and `-std=gnu' options, which can -be used to restrict the set of intrinsic procedures to a given -standard. By default, `gfortran' sets the `-std=gnu' option, and so -all intrinsic procedures described here are accepted. There is one -caveat. For a select group of intrinsic procedures, `g77' implemented -both a function and a subroutine. Both classes have been implemented -in `gfortran' for backwards compatibility with `g77'. It is noted here -that these functions and subroutines cannot be intermixed in a given -subprogram. In the descriptions that follow, the applicable standard -for each intrinsic procedure is noted. + GNU Fortran offers the '-std=f95' and '-std=gnu' options, which can +be used to restrict the set of intrinsic procedures to a given standard. +By default, 'gfortran' sets the '-std=gnu' option, and so all intrinsic +procedures described here are accepted. There is one caveat. For a +select group of intrinsic procedures, 'g77' implemented both a function +and a subroutine. Both classes have been implemented in 'gfortran' for +backwards compatibility with 'g77'. It is noted here that these +functions and subroutines cannot be intermixed in a given subprogram. +In the descriptions that follow, the applicable standard for each +intrinsic procedure is noted. File: gfortran.info, Node: ABORT, Next: ABS, Prev: Introduction to Intrinsics, Up: Intrinsic Procedures -9.2 `ABORT' -- Abort the program +9.2 'ABORT' -- Abort the program ================================ _Description_: - `ABORT' causes immediate termination of the program. On operating - systems that support a core dump, `ABORT' will produce a core dump. - It will also print a backtrace, unless `-fno-backtrace' is given. + 'ABORT' causes immediate termination of the program. On operating + systems that support a core dump, 'ABORT' will produce a core dump. + It will also print a backtrace, unless '-fno-backtrace' is given. _Standard_: GNU extension @@ -5890,7 +6754,7 @@ _Class_: Subroutine _Syntax_: - `CALL ABORT' + 'CALL ABORT' _Return value_: Does not return. @@ -5904,15 +6768,14 @@ _Example_: _See also_: *note EXIT::, *note KILL::, *note BACKTRACE:: - File: gfortran.info, Node: ABS, Next: ACCESS, Prev: ABORT, Up: Intrinsic Procedures -9.3 `ABS' -- Absolute value +9.3 'ABS' -- Absolute value =========================== _Description_: - `ABS(A)' computes the absolute value of `A'. + 'ABS(A)' computes the absolute value of 'A'. _Standard_: Fortran 77 and later, has overloads that are GNU extensions @@ -5921,15 +6784,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = ABS(A)' + 'RESULT = ABS(A)' _Arguments_: - A The type of the argument shall be an `INTEGER', - `REAL', or `COMPLEX'. + A The type of the argument shall be an 'INTEGER', + 'REAL', or 'COMPLEX'. _Return value_: The return value is of the same type and kind as the argument - except the return value is `REAL' for a `COMPLEX' argument. + except the return value is 'REAL' for a 'COMPLEX' argument. _Example_: program test_abs @@ -5942,30 +6805,38 @@ _Example_: end program test_abs _Specific names_: - Name Argument Return type Standard - `ABS(A)' `REAL(4) A' `REAL(4)' Fortran 77 and - later - `CABS(A)' `COMPLEX(4) `REAL(4)' Fortran 77 and - A' later - `DABS(A)' `REAL(8) A' `REAL(8)' Fortran 77 and - later - `IABS(A)' `INTEGER(4) `INTEGER(4)' Fortran 77 and - A' later - `ZABS(A)' `COMPLEX(8) `COMPLEX(8)' GNU extension - A' - `CDABS(A)' `COMPLEX(8) `COMPLEX(8)' GNU extension - A' + Name Argument Return type Standard + 'ABS(A)' 'REAL(4) A' 'REAL(4)' Fortran 77 and + later + 'CABS(A)' 'COMPLEX(4) 'REAL(4)' Fortran 77 and + A' later + 'DABS(A)' 'REAL(8) A' 'REAL(8)' Fortran 77 and + later + 'IABS(A)' 'INTEGER(4) 'INTEGER(4)' Fortran 77 and + A' later + 'BABS(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IIABS(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JIABS(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KIABS(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' + 'ZABS(A)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + A' + 'CDABS(A)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + A' File: gfortran.info, Node: ACCESS, Next: ACHAR, Prev: ABS, Up: Intrinsic Procedures -9.4 `ACCESS' -- Checks file access modes +9.4 'ACCESS' -- Checks file access modes ======================================== _Description_: - `ACCESS(NAME, MODE)' checks whether the file NAME exists, is - readable, writable or executable. Except for the executable check, - `ACCESS' can be replaced by Fortran 95's `INQUIRE'. + 'ACCESS(NAME, MODE)' checks whether the file NAME exists, is + readable, writable or executable. Except for the executable check, + 'ACCESS' can be replaced by Fortran 95's 'INQUIRE'. _Standard_: GNU extension @@ -5974,23 +6845,23 @@ _Class_: Inquiry function _Syntax_: - `RESULT = ACCESS(NAME, MODE)' + 'RESULT = ACCESS(NAME, MODE)' _Arguments_: - NAME Scalar `CHARACTER' of default kind with the - file name. Tailing blank are ignored unless - the character `achar(0)' is present, then all - characters up to and excluding `achar(0)' are - used as file name. - MODE Scalar `CHARACTER' of default kind with the - file access mode, may be any concatenation of - `"r"' (readable), `"w"' (writable) and `"x"' - (executable), or `" "' to check for existence. + NAME Scalar 'CHARACTER' of default kind with the file + name. Tailing blank are ignored unless the + character 'achar(0)' is present, then all + characters up to and excluding 'achar(0)' are + used as file name. + MODE Scalar 'CHARACTER' of default kind with the file + access mode, may be any concatenation of '"r"' + (readable), '"w"' (writable) and '"x"' + (executable), or '" "' to check for existence. _Return value_: - Returns a scalar `INTEGER', which is `0' if the file is accessible + Returns a scalar 'INTEGER', which is '0' if the file is accessible in the given mode; otherwise or if an invalid argument has been - given for `MODE' the value `1' is returned. + given for 'MODE' the value '1' is returned. _Example_: program access_test @@ -6004,19 +6875,17 @@ _Example_: if(access(file2,'rwx') == 0) & print *, trim(file2),' is readable, writable and executable' end program access_test - _Specific names_: - _See also_: File: gfortran.info, Node: ACHAR, Next: ACOS, Prev: ACCESS, Up: Intrinsic Procedures -9.5 `ACHAR' -- Character in ASCII collating sequence +9.5 'ACHAR' -- Character in ASCII collating sequence ==================================================== _Description_: - `ACHAR(I)' returns the character located at position `I' in the + 'ACHAR(I)' returns the character located at position 'I' in the ASCII collating sequence. _Standard_: @@ -6026,16 +6895,16 @@ _Class_: Elemental function _Syntax_: - `RESULT = ACHAR(I [, KIND])' + 'RESULT = ACHAR(I [, KIND])' _Arguments_: - I The type shall be `INTEGER'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + I The type shall be 'INTEGER'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `CHARACTER' with a length of one. If + The return value is of type 'CHARACTER' with a length of one. If the KIND argument is present, the return value is of the specified kind and of the default kind otherwise. @@ -6052,15 +6921,14 @@ _Note_: _See also_: *note CHAR::, *note IACHAR::, *note ICHAR:: - -File: gfortran.info, Node: ACOS, Next: ACOSH, Prev: ACHAR, Up: Intrinsic Procedures +File: gfortran.info, Node: ACOS, Next: ACOSD, Prev: ACHAR, Up: Intrinsic Procedures -9.6 `ACOS' -- Arccosine function +9.6 'ACOS' -- Arccosine function ================================ _Description_: - `ACOS(X)' computes the arccosine of X (inverse of `COS(X)'). + 'ACOS(X)' computes the arccosine of X (inverse of 'COS(X)'). _Standard_: Fortran 77 and later, for a complex argument Fortran 2008 or later @@ -6069,12 +6937,12 @@ _Class_: Elemental function _Syntax_: - `RESULT = ACOS(X)' + 'RESULT = ACOS(X)' _Arguments_: - X The type shall either be `REAL' with a - magnitude that is less than or equal to one - - or the type shall be `COMPLEX'. + X The type shall either be 'REAL' with a magnitude + that is less than or equal to one - or the type + shall be 'COMPLEX'. _Return value_: The return value is of the same type and kind as X. The real part @@ -6088,24 +6956,69 @@ _Example_: end program test_acos _Specific names_: - Name Argument Return type Standard - `ACOS(X)' `REAL(4) X' `REAL(4)' Fortran 77 and - later - `DACOS(X)' `REAL(8) X' `REAL(8)' Fortran 77 and - later + Name Argument Return type Standard + 'ACOS(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and + later + 'DACOS(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and + later _See also_: - Inverse function: *note COS:: + Inverse function: *note COS:: Degrees function: *note ACOSD:: + + +File: gfortran.info, Node: ACOSD, Next: ACOSH, Prev: ACOS, Up: Intrinsic Procedures + +9.7 'ACOSD' -- Arccosine function, degrees +========================================== + +_Description_: + 'ACOSD(X)' computes the arccosine of X in degrees (inverse of + 'COSD(X)'). + + This function is for compatibility only and should be avoided in + favor of standard constructs wherever possible. + +_Standard_: + GNU Extension, enabled with '-fdec-math' + +_Class_: + Elemental function + +_Syntax_: + 'RESULT = ACOSD(X)' + +_Arguments_: + X The type shall either be 'REAL' with a magnitude + that is less than or equal to one - or the type + shall be 'COMPLEX'. + +_Return value_: + The return value is of the same type and kind as X. The real part + of the result is in degrees and lies in the range 0 \leq \Re + \acos(x) \leq 180. + +_Example_: + program test_acosd + real(8) :: x = 0.866_8 + x = acosd(x) + end program test_acosd +_Specific names_: + Name Argument Return type Standard + 'ACOSD(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DACOSD(X)' 'REAL(8) X' 'REAL(8)' GNU Extension + +_See also_: + Inverse function: *note COSD:: Radians function: *note ACOS:: -File: gfortran.info, Node: ACOSH, Next: ADJUSTL, Prev: ACOS, Up: Intrinsic Procedures +File: gfortran.info, Node: ACOSH, Next: ADJUSTL, Prev: ACOSD, Up: Intrinsic Procedures -9.7 `ACOSH' -- Inverse hyperbolic cosine function +9.8 'ACOSH' -- Inverse hyperbolic cosine function ================================================= _Description_: - `ACOSH(X)' computes the inverse hyperbolic cosine of X. + 'ACOSH(X)' computes the inverse hyperbolic cosine of X. _Standard_: Fortran 2008 and later @@ -6114,14 +7027,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = ACOSH(X)' + 'RESULT = ACOSH(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: - The return value has the same type and kind as X. If X is complex, - the imaginary part of the result is in radians and lies between 0 + The return value has the same type and kind as X. If X is complex, + the imaginary part of the result is in radians and lies between 0 \leq \Im \acosh(x) \leq \pi. _Example_: @@ -6131,8 +7044,8 @@ _Example_: END PROGRAM _Specific names_: - Name Argument Return type Standard - `DACOSH(X)' `REAL(8) X' `REAL(8)' GNU extension + Name Argument Return type Standard + 'DACOSH(X)' 'REAL(8) X' 'REAL(8)' GNU extension _See also_: Inverse function: *note COSH:: @@ -6140,11 +7053,11 @@ _See also_: File: gfortran.info, Node: ADJUSTL, Next: ADJUSTR, Prev: ACOSH, Up: Intrinsic Procedures -9.8 `ADJUSTL' -- Left adjust a string +9.9 'ADJUSTL' -- Left adjust a string ===================================== _Description_: - `ADJUSTL(STRING)' will left adjust a string by removing leading + 'ADJUSTL(STRING)' will left adjust a string by removing leading spaces. Spaces are inserted at the end of the string as needed. _Standard_: @@ -6154,13 +7067,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = ADJUSTL(STRING)' + 'RESULT = ADJUSTL(STRING)' _Arguments_: - STRING The type shall be `CHARACTER'. + STRING The type shall be 'CHARACTER'. _Return value_: - The return value is of type `CHARACTER' and of the same kind as + The return value is of type 'CHARACTER' and of the same kind as STRING where leading spaces are removed and the same number of spaces are inserted on the end of STRING. @@ -6177,11 +7090,11 @@ _See also_: File: gfortran.info, Node: ADJUSTR, Next: AIMAG, Prev: ADJUSTL, Up: Intrinsic Procedures -9.9 `ADJUSTR' -- Right adjust a string -====================================== +9.10 'ADJUSTR' -- Right adjust a string +======================================= _Description_: - `ADJUSTR(STRING)' will right adjust a string by removing trailing + 'ADJUSTR(STRING)' will right adjust a string by removing trailing spaces. Spaces are inserted at the start of the string as needed. _Standard_: @@ -6191,13 +7104,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = ADJUSTR(STRING)' + 'RESULT = ADJUSTR(STRING)' _Arguments_: - STR The type shall be `CHARACTER'. + STR The type shall be 'CHARACTER'. _Return value_: - The return value is of type `CHARACTER' and of the same kind as + The return value is of type 'CHARACTER' and of the same kind as STRING where trailing spaces are removed and the same number of spaces are inserted at the start of STRING. @@ -6214,13 +7127,13 @@ _See also_: File: gfortran.info, Node: AIMAG, Next: AINT, Prev: ADJUSTR, Up: Intrinsic Procedures -9.10 `AIMAG' -- Imaginary part of complex number +9.11 'AIMAG' -- Imaginary part of complex number ================================================ _Description_: - `AIMAG(Z)' yields the imaginary part of complex argument `Z'. The - `IMAG(Z)' and `IMAGPART(Z)' intrinsic functions are provided for - compatibility with `g77', and their use in new code is strongly + 'AIMAG(Z)' yields the imaginary part of complex argument 'Z'. The + 'IMAG(Z)' and 'IMAGPART(Z)' intrinsic functions are provided for + compatibility with 'g77', and their use in new code is strongly discouraged. _Standard_: @@ -6230,13 +7143,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = AIMAG(Z)' + 'RESULT = AIMAG(Z)' _Arguments_: - Z The type of the argument shall be `COMPLEX'. + Z The type of the argument shall be 'COMPLEX'. _Return value_: - The return value is of type `REAL' with the kind type parameter of + The return value is of type 'REAL' with the kind type parameter of the argument. _Example_: @@ -6249,21 +7162,21 @@ _Example_: end program test_aimag _Specific names_: - Name Argument Return type Standard - `AIMAG(Z)' `COMPLEX Z' `REAL' GNU extension - `DIMAG(Z)' `COMPLEX(8) `REAL(8)' GNU extension - Z' - `IMAG(Z)' `COMPLEX Z' `REAL' GNU extension - `IMAGPART(Z)' `COMPLEX Z' `REAL' GNU extension + Name Argument Return type Standard + 'AIMAG(Z)' 'COMPLEX Z' 'REAL' GNU extension + 'DIMAG(Z)' 'COMPLEX(8) 'REAL(8)' GNU extension + Z' + 'IMAG(Z)' 'COMPLEX Z' 'REAL' GNU extension + 'IMAGPART(Z)' 'COMPLEX Z' 'REAL' GNU extension File: gfortran.info, Node: AINT, Next: ALARM, Prev: AIMAG, Up: Intrinsic Procedures -9.11 `AINT' -- Truncate to a whole number +9.12 'AINT' -- Truncate to a whole number ========================================= _Description_: - `AINT(A [, KIND])' truncates its argument to a whole number. + 'AINT(A [, KIND])' truncates its argument to a whole number. _Standard_: Fortran 77 and later @@ -6272,19 +7185,19 @@ _Class_: Elemental function _Syntax_: - `RESULT = AINT(A [, KIND])' + 'RESULT = AINT(A [, KIND])' _Arguments_: - A The type of the argument shall be `REAL'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + A The type of the argument shall be 'REAL'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `REAL' with the kind type parameter of + The return value is of type 'REAL' with the kind type parameter of the argument if the optional KIND is absent; otherwise, the kind type parameter will be given by KIND. If the magnitude of X is - less than one, `AINT(X)' returns zero. If the magnitude is equal + less than one, 'AINT(X)' returns zero. If the magnitude is equal to or greater than one then it returns the largest whole number that does not exceed its magnitude. The sign is the same as the sign of X. @@ -6300,25 +7213,25 @@ _Example_: end program test_aint _Specific names_: - Name Argument Return type Standard - `AINT(A)' `REAL(4) A' `REAL(4)' Fortran 77 and - later - `DINT(A)' `REAL(8) A' `REAL(8)' Fortran 77 and - later + Name Argument Return type Standard + 'AINT(A)' 'REAL(4) A' 'REAL(4)' Fortran 77 and + later + 'DINT(A)' 'REAL(8) A' 'REAL(8)' Fortran 77 and + later File: gfortran.info, Node: ALARM, Next: ALL, Prev: AINT, Up: Intrinsic Procedures -9.12 `ALARM' -- Execute a routine after a given delay +9.13 'ALARM' -- Execute a routine after a given delay ===================================================== _Description_: - `ALARM(SECONDS, HANDLER [, STATUS])' causes external subroutine - HANDLER to be executed after a delay of SECONDS by using - `alarm(2)' to set up a signal and `signal(2)' to catch it. If - STATUS is supplied, it will be returned with the number of seconds - remaining until any previously scheduled alarm was due to be - delivered, or zero if there was no previously scheduled alarm. + 'ALARM(SECONDS, HANDLER [, STATUS])' causes external subroutine + HANDLER to be executed after a delay of SECONDS by using 'alarm(2)' + to set up a signal and 'signal(2)' to catch it. If STATUS is + supplied, it will be returned with the number of seconds remaining + until any previously scheduled alarm was due to be delivered, or + zero if there was no previously scheduled alarm. _Standard_: GNU extension @@ -6327,20 +7240,19 @@ _Class_: Subroutine _Syntax_: - `CALL ALARM(SECONDS, HANDLER [, STATUS])' + 'CALL ALARM(SECONDS, HANDLER [, STATUS])' _Arguments_: - SECONDS The type of the argument shall be a scalar - `INTEGER'. It is `INTENT(IN)'. - HANDLER Signal handler (`INTEGER FUNCTION' or - `SUBROUTINE') or dummy/global `INTEGER' - scalar. The scalar values may be either - `SIG_IGN=1' to ignore the alarm generated or - `SIG_DFL=0' to set the default action. It is - `INTENT(IN)'. - STATUS (Optional) STATUS shall be a scalar variable - of the default `INTEGER' kind. It is - `INTENT(OUT)'. + SECONDS The type of the argument shall be a scalar + 'INTEGER'. It is 'INTENT(IN)'. + HANDLER Signal handler ('INTEGER FUNCTION' or + 'SUBROUTINE') or dummy/global 'INTEGER' scalar. + The scalar values may be either 'SIG_IGN=1' to + ignore the alarm generated or 'SIG_DFL=0' to set + the default action. It is 'INTENT(IN)'. + STATUS (Optional) STATUS shall be a scalar variable of + the default 'INTEGER' kind. It is + 'INTENT(OUT)'. _Example_: program test_alarm @@ -6356,11 +7268,11 @@ _Example_: File: gfortran.info, Node: ALL, Next: ALLOCATED, Prev: ALARM, Up: Intrinsic Procedures -9.13 `ALL' -- All values in MASK along DIM are true +9.14 'ALL' -- All values in MASK along DIM are true =================================================== _Description_: - `ALL(MASK [, DIM])' determines if all the values are true in MASK + 'ALL(MASK [, DIM])' determines if all the values are true in MASK in the array along dimension DIM. _Standard_: @@ -6370,30 +7282,29 @@ _Class_: Transformational function _Syntax_: - `RESULT = ALL(MASK [, DIM])' + 'RESULT = ALL(MASK [, DIM])' _Arguments_: - MASK The type of the argument shall be `LOGICAL' and - it shall not be scalar. - DIM (Optional) DIM shall be a scalar integer with - a value that lies between one and the rank of - MASK. + MASK The type of the argument shall be 'LOGICAL' and + it shall not be scalar. + DIM (Optional) DIM shall be a scalar integer with a + value that lies between one and the rank of + MASK. _Return value_: - `ALL(MASK)' returns a scalar value of type `LOGICAL' where the - kind type parameter is the same as the kind type parameter of - MASK. If DIM is present, then `ALL(MASK, DIM)' returns an array - with the rank of MASK minus 1. The shape is determined from the - shape of MASK where the DIM dimension is elided. - - (A) - `ALL(MASK)' is true if all elements of MASK are true. It - also is true if MASK has zero size; otherwise, it is false. - - (B) - If the rank of MASK is one, then `ALL(MASK,DIM)' is equivalent - to `ALL(MASK)'. If the rank is greater than one, then - `ALL(MASK,DIM)' is determined by applying `ALL' to the array + 'ALL(MASK)' returns a scalar value of type 'LOGICAL' where the kind + type parameter is the same as the kind type parameter of MASK. If + DIM is present, then 'ALL(MASK, DIM)' returns an array with the + rank of MASK minus 1. The shape is determined from the shape of + MASK where the DIM dimension is elided. + + (A) + 'ALL(MASK)' is true if all elements of MASK are true. It also + is true if MASK has zero size; otherwise, it is false. + (B) + If the rank of MASK is one, then 'ALL(MASK,DIM)' is equivalent + to 'ALL(MASK)'. If the rank is greater than one, then + 'ALL(MASK,DIM)' is determined by applying 'ALL' to the array sections. _Example_: @@ -6416,32 +7327,32 @@ _Example_: File: gfortran.info, Node: ALLOCATED, Next: AND, Prev: ALL, Up: Intrinsic Procedures -9.14 `ALLOCATED' -- Status of an allocatable entity +9.15 'ALLOCATED' -- Status of an allocatable entity =================================================== _Description_: - `ALLOCATED(ARRAY)' and `ALLOCATED(SCALAR)' check the allocation + 'ALLOCATED(ARRAY)' and 'ALLOCATED(SCALAR)' check the allocation status of ARRAY and SCALAR, respectively. _Standard_: - Fortran 95 and later. Note, the `SCALAR=' keyword and allocatable + Fortran 95 and later. Note, the 'SCALAR=' keyword and allocatable scalar entities are available in Fortran 2003 and later. _Class_: Inquiry function _Syntax_: - `RESULT = ALLOCATED(ARRAY)' - `RESULT = ALLOCATED(SCALAR)' + 'RESULT = ALLOCATED(ARRAY)' + 'RESULT = ALLOCATED(SCALAR)' _Arguments_: - ARRAY The argument shall be an `ALLOCATABLE' array. - SCALAR The argument shall be an `ALLOCATABLE' scalar. + ARRAY The argument shall be an 'ALLOCATABLE' array. + SCALAR The argument shall be an 'ALLOCATABLE' scalar. _Return value_: - The return value is a scalar `LOGICAL' with the default logical - kind type parameter. If the argument is allocated, then the - result is `.TRUE.'; otherwise, it returns `.FALSE.' + The return value is a scalar 'LOGICAL' with the default logical + kind type parameter. If the argument is allocated, then the result + is '.TRUE.'; otherwise, it returns '.FALSE.' _Example_: program test_allocated @@ -6453,11 +7364,11 @@ _Example_: File: gfortran.info, Node: AND, Next: ANINT, Prev: ALLOCATED, Up: Intrinsic Procedures -9.15 `AND' -- Bitwise logical AND +9.16 'AND' -- Bitwise logical AND ================================= _Description_: - Bitwise logical `AND'. + Bitwise logical 'AND'. This intrinsic routine is provided for backwards compatibility with GNU Fortran 77. For integer arguments, programmers should consider @@ -6471,18 +7382,18 @@ _Class_: Function _Syntax_: - `RESULT = AND(I, J)' + 'RESULT = AND(I, J)' _Arguments_: - I The type shall be either a scalar `INTEGER' - type or a scalar `LOGICAL' type. - J The type shall be the same as the type of I. + I The type shall be either a scalar 'INTEGER' type + or a scalar 'LOGICAL' type. + J The type shall be the same as the type of I. _Return value_: - The return type is either a scalar `INTEGER' or a scalar - `LOGICAL'. If the kind type parameters differ, then the smaller - kind type is implicitly converted to larger kind, and the return - has the larger kind. + The return type is either a scalar 'INTEGER' or a scalar 'LOGICAL'. + If the kind type parameters differ, then the smaller kind type is + implicitly converted to larger kind, and the return has the larger + kind. _Example_: PROGRAM test_and @@ -6500,11 +7411,11 @@ _See also_: File: gfortran.info, Node: ANINT, Next: ANY, Prev: AND, Up: Intrinsic Procedures -9.16 `ANINT' -- Nearest whole number +9.17 'ANINT' -- Nearest whole number ==================================== _Description_: - `ANINT(A [, KIND])' rounds its argument to the nearest whole + 'ANINT(A [, KIND])' rounds its argument to the nearest whole number. _Standard_: @@ -6514,20 +7425,20 @@ _Class_: Elemental function _Syntax_: - `RESULT = ANINT(A [, KIND])' + 'RESULT = ANINT(A [, KIND])' _Arguments_: - A The type of the argument shall be `REAL'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + A The type of the argument shall be 'REAL'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: The return value is of type real with the kind type parameter of the argument if the optional KIND is absent; otherwise, the kind type parameter will be given by KIND. If A is greater than zero, - `ANINT(A)' returns `AINT(X+0.5)'. If A is less than or equal to - zero then it returns `AINT(X-0.5)'. + 'ANINT(A)' returns 'AINT(X+0.5)'. If A is less than or equal to + zero then it returns 'AINT(X-0.5)'. _Example_: program test_anint @@ -6540,21 +7451,21 @@ _Example_: end program test_anint _Specific names_: - Name Argument Return type Standard - `AINT(A)' `REAL(4) A' `REAL(4)' Fortran 77 and - later - `DNINT(A)' `REAL(8) A' `REAL(8)' Fortran 77 and - later + Name Argument Return type Standard + 'AINT(A)' 'REAL(4) A' 'REAL(4)' Fortran 77 and + later + 'DNINT(A)' 'REAL(8) A' 'REAL(8)' Fortran 77 and + later File: gfortran.info, Node: ANY, Next: ASIN, Prev: ANINT, Up: Intrinsic Procedures -9.17 `ANY' -- Any value in MASK along DIM is true +9.18 'ANY' -- Any value in MASK along DIM is true ================================================= _Description_: - `ANY(MASK [, DIM])' determines if any of the values in the logical - array MASK along dimension DIM are `.TRUE.'. + 'ANY(MASK [, DIM])' determines if any of the values in the logical + array MASK along dimension DIM are '.TRUE.'. _Standard_: Fortran 95 and later @@ -6563,31 +7474,29 @@ _Class_: Transformational function _Syntax_: - `RESULT = ANY(MASK [, DIM])' + 'RESULT = ANY(MASK [, DIM])' _Arguments_: - MASK The type of the argument shall be `LOGICAL' and - it shall not be scalar. - DIM (Optional) DIM shall be a scalar integer with - a value that lies between one and the rank of - MASK. + MASK The type of the argument shall be 'LOGICAL' and + it shall not be scalar. + DIM (Optional) DIM shall be a scalar integer with a + value that lies between one and the rank of + MASK. _Return value_: - `ANY(MASK)' returns a scalar value of type `LOGICAL' where the - kind type parameter is the same as the kind type parameter of - MASK. If DIM is present, then `ANY(MASK, DIM)' returns an array - with the rank of MASK minus 1. The shape is determined from the - shape of MASK where the DIM dimension is elided. - - (A) - `ANY(MASK)' is true if any element of MASK is true; - otherwise, it is false. It also is false if MASK has zero - size. - - (B) - If the rank of MASK is one, then `ANY(MASK,DIM)' is equivalent - to `ANY(MASK)'. If the rank is greater than one, then - `ANY(MASK,DIM)' is determined by applying `ANY' to the array + 'ANY(MASK)' returns a scalar value of type 'LOGICAL' where the kind + type parameter is the same as the kind type parameter of MASK. If + DIM is present, then 'ANY(MASK, DIM)' returns an array with the + rank of MASK minus 1. The shape is determined from the shape of + MASK where the DIM dimension is elided. + + (A) + 'ANY(MASK)' is true if any element of MASK is true; otherwise, + it is false. It also is false if MASK has zero size. + (B) + If the rank of MASK is one, then 'ANY(MASK,DIM)' is equivalent + to 'ANY(MASK)'. If the rank is greater than one, then + 'ANY(MASK,DIM)' is determined by applying 'ANY' to the array sections. _Example_: @@ -6608,13 +7517,13 @@ _Example_: end program test_any -File: gfortran.info, Node: ASIN, Next: ASINH, Prev: ANY, Up: Intrinsic Procedures +File: gfortran.info, Node: ASIN, Next: ASIND, Prev: ANY, Up: Intrinsic Procedures -9.18 `ASIN' -- Arcsine function +9.19 'ASIN' -- Arcsine function =============================== _Description_: - `ASIN(X)' computes the arcsine of its X (inverse of `SIN(X)'). + 'ASIN(X)' computes the arcsine of its X (inverse of 'SIN(X)'). _Standard_: Fortran 77 and later, for a complex argument Fortran 2008 or later @@ -6623,12 +7532,12 @@ _Class_: Elemental function _Syntax_: - `RESULT = ASIN(X)' + 'RESULT = ASIN(X)' _Arguments_: - X The type shall be either `REAL' and a - magnitude that is less than or equal to one - - or be `COMPLEX'. + X The type shall be either 'REAL' and a magnitude + that is less than or equal to one - or be + 'COMPLEX'. _Return value_: The return value is of the same type and kind as X. The real part @@ -6642,24 +7551,69 @@ _Example_: end program test_asin _Specific names_: - Name Argument Return type Standard - `ASIN(X)' `REAL(4) X' `REAL(4)' Fortran 77 and - later - `DASIN(X)' `REAL(8) X' `REAL(8)' Fortran 77 and - later + Name Argument Return type Standard + 'ASIN(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and + later + 'DASIN(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and + later _See also_: - Inverse function: *note SIN:: + Inverse function: *note SIN:: Degrees function: *note ASIND:: + + +File: gfortran.info, Node: ASIND, Next: ASINH, Prev: ASIN, Up: Intrinsic Procedures +9.20 'ASIND' -- Arcsine function, degrees +========================================= + +_Description_: + 'ASIND(X)' computes the arcsine of its X in degrees (inverse of + 'SIND(X)'). + + This function is for compatibility only and should be avoided in + favor of standard constructs wherever possible. + +_Standard_: + GNU Extension, enabled with '-fdec-math'. + +_Class_: + Elemental function + +_Syntax_: + 'RESULT = ASIND(X)' + +_Arguments_: + X The type shall be either 'REAL' and a magnitude + that is less than or equal to one - or be + 'COMPLEX'. + +_Return value_: + The return value is of the same type and kind as X. The real part + of the result is in degrees and lies in the range -90 \leq \Re + \asin(x) \leq 90. + +_Example_: + program test_asind + real(8) :: x = 0.866_8 + x = asind(x) + end program test_asind + +_Specific names_: + Name Argument Return type Standard + 'ASIND(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DASIND(X)' 'REAL(8) X' 'REAL(8)' GNU Extension + +_See also_: + Inverse function: *note SIND:: Radians function: *note ASIN:: -File: gfortran.info, Node: ASINH, Next: ASSOCIATED, Prev: ASIN, Up: Intrinsic Procedures +File: gfortran.info, Node: ASINH, Next: ASSOCIATED, Prev: ASIND, Up: Intrinsic Procedures -9.19 `ASINH' -- Inverse hyperbolic sine function +9.21 'ASINH' -- Inverse hyperbolic sine function ================================================ _Description_: - `ASINH(X)' computes the inverse hyperbolic sine of X. + 'ASINH(X)' computes the inverse hyperbolic sine of X. _Standard_: Fortran 2008 and later @@ -6668,13 +7622,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = ASINH(X)' + 'RESULT = ASINH(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: - The return value is of the same type and kind as X. If X is + The return value is of the same type and kind as X. If X is complex, the imaginary part of the result is in radians and lies between -\pi/2 \leq \Im \asinh(x) \leq \pi/2. @@ -6685,8 +7639,8 @@ _Example_: END PROGRAM _Specific names_: - Name Argument Return type Standard - `DASINH(X)' `REAL(8) X' `REAL(8)' GNU extension. + Name Argument Return type Standard + 'DASINH(X)' 'REAL(8) X' 'REAL(8)' GNU extension. _See also_: Inverse function: *note SINH:: @@ -6694,11 +7648,11 @@ _See also_: File: gfortran.info, Node: ASSOCIATED, Next: ATAN, Prev: ASINH, Up: Intrinsic Procedures -9.20 `ASSOCIATED' -- Status of a pointer or pointer/target pair +9.22 'ASSOCIATED' -- Status of a pointer or pointer/target pair =============================================================== _Description_: - `ASSOCIATED(POINTER [, TARGET])' determines the status of the + 'ASSOCIATED(POINTER [, TARGET])' determines the status of the pointer POINTER or if POINTER is associated with the target TARGET. _Standard_: @@ -6708,43 +7662,39 @@ _Class_: Inquiry function _Syntax_: - `RESULT = ASSOCIATED(POINTER [, TARGET])' + 'RESULT = ASSOCIATED(POINTER [, TARGET])' _Arguments_: - POINTER POINTER shall have the `POINTER' attribute and - it can be of any type. - TARGET (Optional) TARGET shall be a pointer or a - target. It must have the same type, kind type - parameter, and array rank as POINTER. + POINTER POINTER shall have the 'POINTER' attribute and + it can be of any type. + TARGET (Optional) TARGET shall be a pointer or a + target. It must have the same type, kind type + parameter, and array rank as POINTER. The association status of neither POINTER nor TARGET shall be undefined. _Return value_: - `ASSOCIATED(POINTER)' returns a scalar value of type `LOGICAL(4)'. + 'ASSOCIATED(POINTER)' returns a scalar value of type 'LOGICAL(4)'. There are several cases: - (A) When the optional TARGET is not present then - `ASSOCIATED(POINTER)' is true if POINTER is associated with a + (A) When the optional TARGET is not present then + 'ASSOCIATED(POINTER)' is true if POINTER is associated with a target; otherwise, it returns false. - - (B) If TARGET is present and a scalar target, the result is true if + (B) If TARGET is present and a scalar target, the result is true if TARGET is not a zero-sized storage sequence and the target associated with POINTER occupies the same storage units. If POINTER is disassociated, the result is false. - - (C) If TARGET is present and an array target, the result is true if + (C) If TARGET is present and an array target, the result is true if TARGET and POINTER have the same shape, are not zero-sized arrays, are arrays whose elements are not zero-sized storage sequences, and TARGET and POINTER occupy the same storage units in array element order. As in case(B), the result is false, if POINTER is disassociated. - - (D) If TARGET is present and an scalar pointer, the result is true + (D) If TARGET is present and an scalar pointer, the result is true if TARGET is associated with POINTER, the target associated with TARGET are not zero-sized storage sequences and occupy - the same storage units. The result is false, if either - TARGET or POINTER is disassociated. - - (E) If TARGET is present and an array pointer, the result is true if + the same storage units. The result is false, if either TARGET + or POINTER is disassociated. + (E) If TARGET is present and an array pointer, the result is true if target associated with POINTER and the target associated with TARGET have the same shape, are not zero-sized arrays, are arrays whose elements are not zero-sized storage sequences, @@ -6766,13 +7716,13 @@ _See also_: *note NULL:: -File: gfortran.info, Node: ATAN, Next: ATAN2, Prev: ASSOCIATED, Up: Intrinsic Procedures +File: gfortran.info, Node: ATAN, Next: ATAND, Prev: ASSOCIATED, Up: Intrinsic Procedures -9.21 `ATAN' -- Arctangent function +9.23 'ATAN' -- Arctangent function ================================== _Description_: - `ATAN(X)' computes the arctangent of X. + 'ATAN(X)' computes the arctangent of X. _Standard_: Fortran 77 and later, for a complex argument and for two arguments @@ -6782,21 +7732,21 @@ _Class_: Elemental function _Syntax_: - `RESULT = ATAN(X)' - `RESULT = ATAN(Y, X)' + 'RESULT = ATAN(X)' + 'RESULT = ATAN(Y, X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'; if Y is - present, X shall be REAL. - Y shall - be of the - same type - and kind - as X. + X The type shall be 'REAL' or 'COMPLEX'; if Y is + present, X shall be REAL. + Y shall + be of the + same type + and kind + as X. _Return value_: The return value is of the same type and kind as X. If Y is - present, the result is identical to `ATAN2(Y,X)'. Otherwise, it + present, the result is identical to 'ATAN2(Y,X)'. Otherwise, it the arcus tangent of X, where the real part of the result is in radians and lies in the range -\pi/2 \leq \Re \atan(x) \leq \pi/2. @@ -6807,26 +7757,77 @@ _Example_: end program test_atan _Specific names_: - Name Argument Return type Standard - `ATAN(X)' `REAL(4) X' `REAL(4)' Fortran 77 and - later - `DATAN(X)' `REAL(8) X' `REAL(8)' Fortran 77 and - later + Name Argument Return type Standard + 'ATAN(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and + later + 'DATAN(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and + later _See also_: - Inverse function: *note TAN:: + Inverse function: *note TAN:: Degrees function: *note ATAND:: + + +File: gfortran.info, Node: ATAND, Next: ATAN2, Prev: ATAN, Up: Intrinsic Procedures + +9.24 'ATAND' -- Arctangent function, degrees +============================================ + +_Description_: + 'ATAND(X)' computes the arctangent of X in degrees (inverse of + *note TAND::). + + This function is for compatibility only and should be avoided in + favor of standard constructs wherever possible. +_Standard_: + GNU Extension, enabled with '-fdec-math'. + +_Class_: + Elemental function + +_Syntax_: + 'RESULT = ATAND(X)' + 'RESULT = ATAND(Y, X)' + +_Arguments_: + X The type shall be 'REAL' or 'COMPLEX'; if Y is + present, X shall be REAL. + Y shall + be of the + same type + and kind + as X. + +_Return value_: + The return value is of the same type and kind as X. If Y is + present, the result is identical to 'ATAND2(Y,X)'. Otherwise, it + is the arcus tangent of X, where the real part of the result is in + degrees and lies in the range -90 \leq \Re \atand(x) \leq 90. + +_Example_: + program test_atand + real(8) :: x = 2.866_8 + x = atand(x) + end program test_atand + +_Specific names_: + Name Argument Return type Standard + 'ATAND(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DATAND(X)' 'REAL(8) X' 'REAL(8)' GNU Extension + +_See also_: + Inverse function: *note TAND:: Radians function: *note ATAN:: -File: gfortran.info, Node: ATAN2, Next: ATANH, Prev: ATAN, Up: Intrinsic Procedures +File: gfortran.info, Node: ATAN2, Next: ATAN2D, Prev: ATAND, Up: Intrinsic Procedures -9.22 `ATAN2' -- Arctangent function +9.25 'ATAN2' -- Arctangent function =================================== _Description_: - `ATAN2(Y, X)' computes the principal value of the argument - function of the complex number X + i Y. This function can be used - to transform from Cartesian into polar coordinates and allows to + 'ATAN2(Y, X)' computes the principal value of the argument function + of the complex number X + i Y. This function can be used to + transform from Cartesian into polar coordinates and allows to determine the angle in the correct quadrant. _Standard_: @@ -6836,17 +7837,17 @@ _Class_: Elemental function _Syntax_: - `RESULT = ATAN2(Y, X)' + 'RESULT = ATAN2(Y, X)' _Arguments_: - Y The type shall be `REAL'. - X The type and kind type parameter shall be the - same as Y. If Y is zero, then X must be - nonzero. + Y The type shall be 'REAL'. + X The type and kind type parameter shall be the + same as Y. If Y is zero, then X must be + nonzero. _Return value_: - The return value has the same type and kind type parameter as Y. It - is the principal value of the complex number X + i Y. If X is + The return value has the same type and kind type parameter as Y. + It is the principal value of the complex number X + i Y. If X is nonzero, then it lies in the range -\pi \le \atan (x) \leq \pi. The sign is positive if Y is positive. If Y is zero, then the return value is zero if X is strictly positive, \pi if X is @@ -6861,20 +7862,79 @@ _Example_: end program test_atan2 _Specific names_: - Name Argument Return type Standard - `ATAN2(X, `REAL(4) X, `REAL(4)' Fortran 77 and - Y)' Y' later - `DATAN2(X, `REAL(8) X, `REAL(8)' Fortran 77 and - Y)' Y' later + Name Argument Return type Standard + 'ATAN2(X, 'REAL(4) X, 'REAL(4)' Fortran 77 and + Y)' Y' later + 'DATAN2(X, 'REAL(8) X, 'REAL(8)' Fortran 77 and + Y)' Y' later + +_See also_: + Alias: *note ATAN:: Degrees function: *note ATAN2D:: -File: gfortran.info, Node: ATANH, Next: ATOMIC_ADD, Prev: ATAN2, Up: Intrinsic Procedures +File: gfortran.info, Node: ATAN2D, Next: ATANH, Prev: ATAN2, Up: Intrinsic Procedures + +9.26 'ATAN2D' -- Arctangent function, degrees +============================================= + +_Description_: + 'ATAN2D(Y, X)' computes the principal value of the argument + function of the complex number X + i Y in degrees. This function + can be used to transform from Cartesian into polar coordinates and + allows to determine the angle in the correct quadrant. + + This function is for compatibility only and should be avoided in + favor of standard constructs wherever possible. + +_Standard_: + GNU Extension, enabled with '-fdec-math'. + +_Class_: + Elemental function + +_Syntax_: + 'RESULT = ATAN2D(Y, X)' + +_Arguments_: + Y The type shall be 'REAL'. + X The type and kind type parameter shall be the + same as Y. If Y is zero, then X must be + nonzero. -9.23 `ATANH' -- Inverse hyperbolic tangent function +_Return value_: + The return value has the same type and kind type parameter as Y. + It is the principal value of the complex number X + i Y. If X is + nonzero, then it lies in the range -180 \le \atan (x) \leq 180. + The sign is positive if Y is positive. If Y is zero, then the + return value is zero if X is strictly positive, 180 if X is + negative and Y is positive zero (or the processor does not handle + signed zeros), and -180 if X is negative and Y is negative zero. + Finally, if X is zero, then the magnitude of the result is 90. + +_Example_: + program test_atan2d + real(4) :: x = 1.e0_4, y = 0.5e0_4 + x = atan2d(y,x) + end program test_atan2d + +_Specific names_: + Name Argument Return type Standard + 'ATAN2D(X, 'REAL(4) X, 'REAL(4)' GNU Extension + Y)' Y' + 'DATAN2D(X, 'REAL(8) X, 'REAL(8)' GNU Extension + Y)' Y' + +_See also_: + Alias: *note ATAND:: Radians function: *note ATAN2:: + + +File: gfortran.info, Node: ATANH, Next: ATOMIC_ADD, Prev: ATAN2D, Up: Intrinsic Procedures + +9.27 'ATANH' -- Inverse hyperbolic tangent function =================================================== _Description_: - `ATANH(X)' computes the inverse hyperbolic tangent of X. + 'ATANH(X)' computes the inverse hyperbolic tangent of X. _Standard_: Fortran 2008 and later @@ -6883,13 +7943,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = ATANH(X)' + 'RESULT = ATANH(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: - The return value has same type and kind as X. If X is complex, the + The return value has same type and kind as X. If X is complex, the imaginary part of the result is in radians and lies between -\pi/2 \leq \Im \atanh(x) \leq \pi/2. @@ -6900,8 +7960,8 @@ _Example_: END PROGRAM _Specific names_: - Name Argument Return type Standard - `DATANH(X)' `REAL(8) X' `REAL(8)' GNU extension + Name Argument Return type Standard + 'DATANH(X)' 'REAL(8) X' 'REAL(8)' GNU extension _See also_: Inverse function: *note TANH:: @@ -6909,18 +7969,18 @@ _See also_: File: gfortran.info, Node: ATOMIC_ADD, Next: ATOMIC_AND, Prev: ATANH, Up: Intrinsic Procedures -9.24 `ATOMIC_ADD' -- Atomic ADD operation +9.28 'ATOMIC_ADD' -- Atomic ADD operation ========================================= _Description_: - `ATOMIC_ADD(ATOM, VALUE)' atomically adds the value of VAR to the - variable ATOM. When STAT is present and the invokation was - successful, it is assigned the value 0. If it is present and the - invokation has failed, it is assigned a positive value; in + 'ATOMIC_ADD(ATOM, VALUE)' atomically adds the value of VAR to the + variable ATOM. When STAT is present and the invocation was + successful, it is assigned the value 0. If it is present and the + invocation has failed, it is assigned a positive value; in particular, for a coindexed ATOM, if the remote image has stopped, - it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + it is assigned the value of 'ISO_FORTRAN_ENV''s + 'STAT_STOPPED_IMAGE' and if the remote image has failed, the value + 'STAT_FAILED_IMAGE'. _Standard_: TS 18508 or later @@ -6929,16 +7989,15 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_ADD (ATOM, VALUE [, STAT])' + 'CALL ATOMIC_ADD (ATOM, VALUE [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of integer - type with `ATOMIC_INT_KIND' kind. - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of integer + type with 'ATOMIC_INT_KIND' kind. + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -6955,18 +8014,18 @@ _See also_: File: gfortran.info, Node: ATOMIC_AND, Next: ATOMIC_CAS, Prev: ATOMIC_ADD, Up: Intrinsic Procedures -9.25 `ATOMIC_AND' -- Atomic bitwise AND operation +9.29 'ATOMIC_AND' -- Atomic bitwise AND operation ================================================= _Description_: - `ATOMIC_AND(ATOM, VALUE)' atomically defines ATOM with the bitwise - AND between the values of ATOM and VALUE. When STAT is present and - the invokation was successful, it is assigned the value 0. If it - is present and the invokation has failed, it is assigned a - positive value; in particular, for a coindexed ATOM, if the remote - image has stopped, it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + 'ATOMIC_AND(ATOM, VALUE)' atomically defines ATOM with the bitwise + AND between the values of ATOM and VALUE. When STAT is present and + the invocation was successful, it is assigned the value 0. If it + is present and the invocation has failed, it is assigned a positive + value; in particular, for a coindexed ATOM, if the remote image has + stopped, it is assigned the value of 'ISO_FORTRAN_ENV''s + 'STAT_STOPPED_IMAGE' and if the remote image has failed, the value + 'STAT_FAILED_IMAGE'. _Standard_: TS 18508 or later @@ -6975,16 +8034,15 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_AND (ATOM, VALUE [, STAT])' + 'CALL ATOMIC_AND (ATOM, VALUE [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of integer - type with `ATOMIC_INT_KIND' kind. - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of integer + type with 'ATOMIC_INT_KIND' kind. + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7001,20 +8059,20 @@ _See also_: File: gfortran.info, Node: ATOMIC_CAS, Next: ATOMIC_DEFINE, Prev: ATOMIC_AND, Up: Intrinsic Procedures -9.26 `ATOMIC_CAS' -- Atomic compare and swap +9.30 'ATOMIC_CAS' -- Atomic compare and swap ============================================ _Description_: - `ATOMIC_CAS' compares the variable ATOM with the value of COMPARE; + 'ATOMIC_CAS' compares the variable ATOM with the value of COMPARE; if the value is the same, ATOM is set to the value of NEW. - Additionally, OLD is set to the value of ATOM that was used for - the comparison. When STAT is present and the invokation was - successful, it is assigned the value 0. If it is present and the - invokation has failed, it is assigned a positive value; in + Additionally, OLD is set to the value of ATOM that was used for the + comparison. When STAT is present and the invocation was + successful, it is assigned the value 0. If it is present and the + invocation has failed, it is assigned a positive value; in particular, for a coindexed ATOM, if the remote image has stopped, - it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + it is assigned the value of 'ISO_FORTRAN_ENV''s + 'STAT_STOPPED_IMAGE' and if the remote image has failed, the value + 'STAT_FAILED_IMAGE'. _Standard_: TS 18508 or later @@ -7023,20 +8081,19 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_CAS (ATOM, OLD, COMPARE, NEW [, STAT])' + 'CALL ATOMIC_CAS (ATOM, OLD, COMPARE, NEW [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of either - integer type with `ATOMIC_INT_KIND' kind or - logical type with `ATOMIC_LOGICAL_KIND' kind. - OLD Scalar of the same type and kind as ATOM. - COMPARE Scalar variable of the same type and kind as - ATOM. - NEW Scalar variable of the same type as ATOM. If - kind is different, the value is converted to - the kind of ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of either + integer type with 'ATOMIC_INT_KIND' kind or + logical type with 'ATOMIC_LOGICAL_KIND' kind. + OLD Scalar of the same type and kind as ATOM. + COMPARE Scalar variable of the same type and kind as + ATOM. + NEW Scalar variable of the same type as ATOM. If + kind is different, the value is converted to the + kind of ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7051,18 +8108,18 @@ _See also_: File: gfortran.info, Node: ATOMIC_DEFINE, Next: ATOMIC_FETCH_ADD, Prev: ATOMIC_CAS, Up: Intrinsic Procedures -9.27 `ATOMIC_DEFINE' -- Setting a variable atomically +9.31 'ATOMIC_DEFINE' -- Setting a variable atomically ===================================================== _Description_: - `ATOMIC_DEFINE(ATOM, VALUE)' defines the variable ATOM with the - value VALUE atomically. When STAT is present and the invokation was - successful, it is assigned the value 0. If it is present and the - invokation has failed, it is assigned a positive value; in + 'ATOMIC_DEFINE(ATOM, VALUE)' defines the variable ATOM with the + value VALUE atomically. When STAT is present and the invocation + was successful, it is assigned the value 0. If it is present and + the invocation has failed, it is assigned a positive value; in particular, for a coindexed ATOM, if the remote image has stopped, - it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + it is assigned the value of 'ISO_FORTRAN_ENV''s + 'STAT_STOPPED_IMAGE' and if the remote image has failed, the value + 'STAT_FAILED_IMAGE'. _Standard_: Fortran 2008 and later; with STAT, TS 18508 or later @@ -7071,17 +8128,17 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_DEFINE (ATOM, VALUE [, STAT])' + 'CALL ATOMIC_DEFINE (ATOM, VALUE [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of either - integer type with `ATOMIC_INT_KIND' kind or - logical type with `ATOMIC_LOGICAL_KIND' kind. - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of either + integer type with 'ATOMIC_INT_KIND' kind or + logical type with 'ATOMIC_LOGICAL_KIND' kind. + + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7098,18 +8155,18 @@ _See also_: File: gfortran.info, Node: ATOMIC_FETCH_ADD, Next: ATOMIC_FETCH_AND, Prev: ATOMIC_DEFINE, Up: Intrinsic Procedures -9.28 `ATOMIC_FETCH_ADD' -- Atomic ADD operation with prior fetch +9.32 'ATOMIC_FETCH_ADD' -- Atomic ADD operation with prior fetch ================================================================ _Description_: - `ATOMIC_FETCH_ADD(ATOM, VALUE, OLD)' atomically stores the value of - ATOM in OLD and adds the value of VAR to the variable ATOM. When - STAT is present and the invokation was successful, it is assigned - the value 0. If it is present and the invokation has failed, it is + 'ATOMIC_FETCH_ADD(ATOM, VALUE, OLD)' atomically stores the value of + ATOM in OLD and adds the value of VAR to the variable ATOM. When + STAT is present and the invocation was successful, it is assigned + the value 0. If it is present and the invocation has failed, it is assigned a positive value; in particular, for a coindexed ATOM, if the remote image has stopped, it is assigned the value of - `ISO_FORTRAN_ENV''s `STAT_STOPPED_IMAGE' and if the remote image - has failed, the value `STAT_FAILED_IMAGE'. + 'ISO_FORTRAN_ENV''s 'STAT_STOPPED_IMAGE' and if the remote image + has failed, the value 'STAT_FAILED_IMAGE'. _Standard_: TS 18508 or later @@ -7118,18 +8175,18 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_FETCH_ADD (ATOM, VALUE, old [, STAT])' + 'CALL ATOMIC_FETCH_ADD (ATOM, VALUE, old [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of integer - type with `ATOMIC_INT_KIND' kind. - `ATOMIC_LOGICAL_KIND' kind. - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - OLD Scalar of the same type and kind as ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of integer + type with 'ATOMIC_INT_KIND' kind. + 'ATOMIC_LOGICAL_KIND' kind. + + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + OLD Scalar of the same type and kind as ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7146,19 +8203,19 @@ _See also_: File: gfortran.info, Node: ATOMIC_FETCH_AND, Next: ATOMIC_FETCH_OR, Prev: ATOMIC_FETCH_ADD, Up: Intrinsic Procedures -9.29 `ATOMIC_FETCH_AND' -- Atomic bitwise AND operation with prior fetch +9.33 'ATOMIC_FETCH_AND' -- Atomic bitwise AND operation with prior fetch ======================================================================== _Description_: - `ATOMIC_AND(ATOM, VALUE)' atomically stores the value of ATOM in + 'ATOMIC_AND(ATOM, VALUE)' atomically stores the value of ATOM in OLD and defines ATOM with the bitwise AND between the values of - ATOM and VALUE. When STAT is present and the invokation was - successful, it is assigned the value 0. If it is present and the - invokation has failed, it is assigned a positive value; in + ATOM and VALUE. When STAT is present and the invocation was + successful, it is assigned the value 0. If it is present and the + invocation has failed, it is assigned a positive value; in particular, for a coindexed ATOM, if the remote image has stopped, - it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + it is assigned the value of 'ISO_FORTRAN_ENV''s + 'STAT_STOPPED_IMAGE' and if the remote image has failed, the value + 'STAT_FAILED_IMAGE'. _Standard_: TS 18508 or later @@ -7167,17 +8224,16 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_FETCH_AND (ATOM, VALUE, OLD [, STAT])' + 'CALL ATOMIC_FETCH_AND (ATOM, VALUE, OLD [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of integer - type with `ATOMIC_INT_KIND' kind. - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - OLD Scalar of the same type and kind as ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of integer + type with 'ATOMIC_INT_KIND' kind. + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + OLD Scalar of the same type and kind as ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7194,19 +8250,18 @@ _See also_: File: gfortran.info, Node: ATOMIC_FETCH_OR, Next: ATOMIC_FETCH_XOR, Prev: ATOMIC_FETCH_AND, Up: Intrinsic Procedures -9.30 `ATOMIC_FETCH_OR' -- Atomic bitwise OR operation with prior fetch +9.34 'ATOMIC_FETCH_OR' -- Atomic bitwise OR operation with prior fetch ====================================================================== _Description_: - `ATOMIC_OR(ATOM, VALUE)' atomically stores the value of ATOM in - OLD and defines ATOM with the bitwise OR between the values of - ATOM and VALUE. When STAT is present and the invokation was - successful, it is assigned the value 0. If it is present and the - invokation has failed, it is assigned a positive value; in - particular, for a coindexed ATOM, if the remote image has stopped, - it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + 'ATOMIC_OR(ATOM, VALUE)' atomically stores the value of ATOM in OLD + and defines ATOM with the bitwise OR between the values of ATOM and + VALUE. When STAT is present and the invocation was successful, it + is assigned the value 0. If it is present and the invocation has + failed, it is assigned a positive value; in particular, for a + coindexed ATOM, if the remote image has stopped, it is assigned the + value of 'ISO_FORTRAN_ENV''s 'STAT_STOPPED_IMAGE' and if the remote + image has failed, the value 'STAT_FAILED_IMAGE'. _Standard_: TS 18508 or later @@ -7215,17 +8270,16 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_FETCH_OR (ATOM, VALUE, OLD [, STAT])' + 'CALL ATOMIC_FETCH_OR (ATOM, VALUE, OLD [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of integer - type with `ATOMIC_INT_KIND' kind. - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - OLD Scalar of the same type and kind as ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of integer + type with 'ATOMIC_INT_KIND' kind. + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + OLD Scalar of the same type and kind as ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7242,19 +8296,19 @@ _See also_: File: gfortran.info, Node: ATOMIC_FETCH_XOR, Next: ATOMIC_OR, Prev: ATOMIC_FETCH_OR, Up: Intrinsic Procedures -9.31 `ATOMIC_FETCH_XOR' -- Atomic bitwise XOR operation with prior fetch +9.35 'ATOMIC_FETCH_XOR' -- Atomic bitwise XOR operation with prior fetch ======================================================================== _Description_: - `ATOMIC_XOR(ATOM, VALUE)' atomically stores the value of ATOM in + 'ATOMIC_XOR(ATOM, VALUE)' atomically stores the value of ATOM in OLD and defines ATOM with the bitwise XOR between the values of - ATOM and VALUE. When STAT is present and the invokation was - successful, it is assigned the value 0. If it is present and the - invokation has failed, it is assigned a positive value; in + ATOM and VALUE. When STAT is present and the invocation was + successful, it is assigned the value 0. If it is present and the + invocation has failed, it is assigned a positive value; in particular, for a coindexed ATOM, if the remote image has stopped, - it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + it is assigned the value of 'ISO_FORTRAN_ENV''s + 'STAT_STOPPED_IMAGE' and if the remote image has failed, the value + 'STAT_FAILED_IMAGE'. _Standard_: TS 18508 or later @@ -7263,17 +8317,16 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_FETCH_XOR (ATOM, VALUE, OLD [, STAT])' + 'CALL ATOMIC_FETCH_XOR (ATOM, VALUE, OLD [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of integer - type with `ATOMIC_INT_KIND' kind. - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - OLD Scalar of the same type and kind as ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of integer + type with 'ATOMIC_INT_KIND' kind. + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + OLD Scalar of the same type and kind as ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7290,18 +8343,18 @@ _See also_: File: gfortran.info, Node: ATOMIC_OR, Next: ATOMIC_REF, Prev: ATOMIC_FETCH_XOR, Up: Intrinsic Procedures -9.32 `ATOMIC_OR' -- Atomic bitwise OR operation +9.36 'ATOMIC_OR' -- Atomic bitwise OR operation =============================================== _Description_: - `ATOMIC_OR(ATOM, VALUE)' atomically defines ATOM with the bitwise - AND between the values of ATOM and VALUE. When STAT is present and - the invokation was successful, it is assigned the value 0. If it - is present and the invokation has failed, it is assigned a - positive value; in particular, for a coindexed ATOM, if the remote - image has stopped, it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + 'ATOMIC_OR(ATOM, VALUE)' atomically defines ATOM with the bitwise + AND between the values of ATOM and VALUE. When STAT is present and + the invocation was successful, it is assigned the value 0. If it + is present and the invocation has failed, it is assigned a positive + value; in particular, for a coindexed ATOM, if the remote image has + stopped, it is assigned the value of 'ISO_FORTRAN_ENV''s + 'STAT_STOPPED_IMAGE' and if the remote image has failed, the value + 'STAT_FAILED_IMAGE'. _Standard_: TS 18508 or later @@ -7310,16 +8363,15 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_OR (ATOM, VALUE [, STAT])' + 'CALL ATOMIC_OR (ATOM, VALUE [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of integer - type with `ATOMIC_INT_KIND' kind. - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of integer + type with 'ATOMIC_INT_KIND' kind. + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7336,18 +8388,18 @@ _See also_: File: gfortran.info, Node: ATOMIC_REF, Next: ATOMIC_XOR, Prev: ATOMIC_OR, Up: Intrinsic Procedures -9.33 `ATOMIC_REF' -- Obtaining the value of a variable atomically +9.37 'ATOMIC_REF' -- Obtaining the value of a variable atomically ================================================================= _Description_: - `ATOMIC_DEFINE(ATOM, VALUE)' atomically assigns the value of the - variable ATOM to VALUE. When STAT is present and the invokation - was successful, it is assigned the value 0. If it is present and - the invokation has failed, it is assigned a positive value; in + 'ATOMIC_DEFINE(ATOM, VALUE)' atomically assigns the value of the + variable ATOM to VALUE. When STAT is present and the invocation + was successful, it is assigned the value 0. If it is present and + the invocation has failed, it is assigned a positive value; in particular, for a coindexed ATOM, if the remote image has stopped, - it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + it is assigned the value of 'ISO_FORTRAN_ENV''s + 'STAT_STOPPED_IMAGE' and if the remote image has failed, the value + 'STAT_FAILED_IMAGE'. _Standard_: Fortran 2008 and later; with STAT, TS 18508 or later @@ -7356,17 +8408,16 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_REF(VALUE, ATOM [, STAT])' + 'CALL ATOMIC_REF(VALUE, ATOM [, STAT])' _Arguments_: - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - ATOM Scalar coarray or coindexed variable of either - integer type with `ATOMIC_INT_KIND' kind or - logical type with `ATOMIC_LOGICAL_KIND' kind. - STAT (optional) Scalar default-kind integer - variable. + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + ATOM Scalar coarray or coindexed variable of either + integer type with 'ATOMIC_INT_KIND' kind or + logical type with 'ATOMIC_LOGICAL_KIND' kind. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7389,18 +8440,18 @@ _See also_: File: gfortran.info, Node: ATOMIC_XOR, Next: BACKTRACE, Prev: ATOMIC_REF, Up: Intrinsic Procedures -9.34 `ATOMIC_XOR' -- Atomic bitwise OR operation +9.38 'ATOMIC_XOR' -- Atomic bitwise OR operation ================================================ _Description_: - `ATOMIC_AND(ATOM, VALUE)' atomically defines ATOM with the bitwise - XOR between the values of ATOM and VALUE. When STAT is present and - the invokation was successful, it is assigned the value 0. If it - is present and the invokation has failed, it is assigned a - positive value; in particular, for a coindexed ATOM, if the remote - image has stopped, it is assigned the value of `ISO_FORTRAN_ENV''s - `STAT_STOPPED_IMAGE' and if the remote image has failed, the value - `STAT_FAILED_IMAGE'. + 'ATOMIC_AND(ATOM, VALUE)' atomically defines ATOM with the bitwise + XOR between the values of ATOM and VALUE. When STAT is present and + the invocation was successful, it is assigned the value 0. If it + is present and the invocation has failed, it is assigned a positive + value; in particular, for a coindexed ATOM, if the remote image has + stopped, it is assigned the value of 'ISO_FORTRAN_ENV''s + 'STAT_STOPPED_IMAGE' and if the remote image has failed, the value + 'STAT_FAILED_IMAGE'. _Standard_: TS 18508 or later @@ -7409,16 +8460,15 @@ _Class_: Atomic subroutine _Syntax_: - `CALL ATOMIC_XOR (ATOM, VALUE [, STAT])' + 'CALL ATOMIC_XOR (ATOM, VALUE [, STAT])' _Arguments_: - ATOM Scalar coarray or coindexed variable of integer - type with `ATOMIC_INT_KIND' kind. - VALUE Scalar of the same type as ATOM. If the kind - is different, the value is converted to the - kind of ATOM. - STAT (optional) Scalar default-kind integer - variable. + ATOM Scalar coarray or coindexed variable of integer + type with 'ATOMIC_INT_KIND' kind. + VALUE Scalar of the same type as ATOM. If the kind is + different, the value is converted to the kind of + ATOM. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -7435,14 +8485,14 @@ _See also_: File: gfortran.info, Node: BACKTRACE, Next: BESSEL_J0, Prev: ATOMIC_XOR, Up: Intrinsic Procedures -9.35 `BACKTRACE' -- Show a backtrace +9.39 'BACKTRACE' -- Show a backtrace ==================================== _Description_: - `BACKTRACE' shows a backtrace at an arbitrary place in user code. - Program execution continues normally afterwards. The backtrace - information is printed to the unit corresponding to `ERROR_UNIT' - in `ISO_FORTRAN_ENV'. + 'BACKTRACE' shows a backtrace at an arbitrary place in user code. + Program execution continues normally afterwards. The backtrace + information is printed to the unit corresponding to 'ERROR_UNIT' in + 'ISO_FORTRAN_ENV'. _Standard_: GNU Extension @@ -7451,7 +8501,7 @@ _Class_: Subroutine _Syntax_: - `CALL BACKTRACE' + 'CALL BACKTRACE' _Arguments_: None @@ -7462,12 +8512,12 @@ _See also_: File: gfortran.info, Node: BESSEL_J0, Next: BESSEL_J1, Prev: BACKTRACE, Up: Intrinsic Procedures -9.36 `BESSEL_J0' -- Bessel function of the first kind of order 0 +9.40 'BESSEL_J0' -- Bessel function of the first kind of order 0 ================================================================ _Description_: - `BESSEL_J0(X)' computes the Bessel function of the first kind of - order 0 of X. This function is available under the name `BESJ0' as + 'BESSEL_J0(X)' computes the Bessel function of the first kind of + order 0 of X. This function is available under the name 'BESJ0' as a GNU extension. _Standard_: @@ -7477,14 +8527,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = BESSEL_J0(X)' + 'RESULT = BESSEL_J0(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: - The return value is of type `REAL' and lies in the range - - 0.4027... \leq Bessel (0,x) \leq 1. It has the same kind as X. + The return value is of type 'REAL' and lies in the range - + 0.4027... \leq Bessel (0,x) \leq 1. It has the same kind as X. _Example_: program test_besj0 @@ -7493,18 +8543,18 @@ _Example_: end program test_besj0 _Specific names_: - Name Argument Return type Standard - `DBESJ0(X)' `REAL(8) X' `REAL(8)' GNU extension + Name Argument Return type Standard + 'DBESJ0(X)' 'REAL(8) X' 'REAL(8)' GNU extension File: gfortran.info, Node: BESSEL_J1, Next: BESSEL_JN, Prev: BESSEL_J0, Up: Intrinsic Procedures -9.37 `BESSEL_J1' -- Bessel function of the first kind of order 1 +9.41 'BESSEL_J1' -- Bessel function of the first kind of order 1 ================================================================ _Description_: - `BESSEL_J1(X)' computes the Bessel function of the first kind of - order 1 of X. This function is available under the name `BESJ1' as + 'BESSEL_J1(X)' computes the Bessel function of the first kind of + order 1 of X. This function is available under the name 'BESJ1' as a GNU extension. _Standard_: @@ -7514,14 +8564,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = BESSEL_J1(X)' + 'RESULT = BESSEL_J1(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: - The return value is of type `REAL' and lies in the range - - 0.5818... \leq Bessel (0,x) \leq 0.5818 . It has the same kind as + The return value is of type 'REAL' and lies in the range - + 0.5818... \leq Bessel (0,x) \leq 0.5818 . It has the same kind as X. _Example_: @@ -7531,22 +8581,22 @@ _Example_: end program test_besj1 _Specific names_: - Name Argument Return type Standard - `DBESJ1(X)' `REAL(8) X' `REAL(8)' GNU extension + Name Argument Return type Standard + 'DBESJ1(X)' 'REAL(8) X' 'REAL(8)' GNU extension File: gfortran.info, Node: BESSEL_JN, Next: BESSEL_Y0, Prev: BESSEL_J1, Up: Intrinsic Procedures -9.38 `BESSEL_JN' -- Bessel function of the first kind +9.42 'BESSEL_JN' -- Bessel function of the first kind ===================================================== _Description_: - `BESSEL_JN(N, X)' computes the Bessel function of the first kind of - order N of X. This function is available under the name `BESJN' as + 'BESSEL_JN(N, X)' computes the Bessel function of the first kind of + order N of X. This function is available under the name 'BESJN' as a GNU extension. If N and X are arrays, their ranks and shapes shall conform. - `BESSEL_JN(N1, N2, X)' returns an array with the Bessel functions + 'BESSEL_JN(N1, N2, X)' returns an array with the Bessel functions of the first kind of the orders N1 to N2. _Standard_: @@ -7554,24 +8604,23 @@ _Standard_: _Class_: Elemental function, except for the transformational function - `BESSEL_JN(N1, N2, X)' + 'BESSEL_JN(N1, N2, X)' _Syntax_: - `RESULT = BESSEL_JN(N, X)' - `RESULT = BESSEL_JN(N1, N2, X)' + 'RESULT = BESSEL_JN(N, X)' + 'RESULT = BESSEL_JN(N1, N2, X)' _Arguments_: - N Shall be a scalar or an array of type - `INTEGER'. - N1 Shall be a non-negative scalar of type - `INTEGER'. - N2 Shall be a non-negative scalar of type - `INTEGER'. - X Shall be a scalar or an array of type `REAL'; - for `BESSEL_JN(N1, N2, X)' it shall be scalar. + N Shall be a scalar or an array of type 'INTEGER'. + N1 Shall be a non-negative scalar of type + 'INTEGER'. + N2 Shall be a non-negative scalar of type + 'INTEGER'. + X Shall be a scalar or an array of type 'REAL'; + for 'BESSEL_JN(N1, N2, X)' it shall be scalar. _Return value_: - The return value is a scalar of type `REAL'. It has the same kind + The return value is a scalar of type 'REAL'. It has the same kind as X. _Note_: @@ -7586,20 +8635,20 @@ _Example_: end program test_besjn _Specific names_: - Name Argument Return type Standard - `DBESJN(N, `INTEGER N' `REAL(8)' GNU extension - X)' - `REAL(8) X' + Name Argument Return type Standard + 'DBESJN(N, 'INTEGER N' 'REAL(8)' GNU extension + X)' + 'REAL(8) X' File: gfortran.info, Node: BESSEL_Y0, Next: BESSEL_Y1, Prev: BESSEL_JN, Up: Intrinsic Procedures -9.39 `BESSEL_Y0' -- Bessel function of the second kind of order 0 +9.43 'BESSEL_Y0' -- Bessel function of the second kind of order 0 ================================================================= _Description_: - `BESSEL_Y0(X)' computes the Bessel function of the second kind of - order 0 of X. This function is available under the name `BESY0' as + 'BESSEL_Y0(X)' computes the Bessel function of the second kind of + order 0 of X. This function is available under the name 'BESY0' as a GNU extension. _Standard_: @@ -7609,13 +8658,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = BESSEL_Y0(X)' + 'RESULT = BESSEL_Y0(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: - The return value is of type `REAL'. It has the same kind as X. + The return value is of type 'REAL'. It has the same kind as X. _Example_: program test_besy0 @@ -7624,18 +8673,18 @@ _Example_: end program test_besy0 _Specific names_: - Name Argument Return type Standard - `DBESY0(X)' `REAL(8) X' `REAL(8)' GNU extension + Name Argument Return type Standard + 'DBESY0(X)' 'REAL(8) X' 'REAL(8)' GNU extension File: gfortran.info, Node: BESSEL_Y1, Next: BESSEL_YN, Prev: BESSEL_Y0, Up: Intrinsic Procedures -9.40 `BESSEL_Y1' -- Bessel function of the second kind of order 1 +9.44 'BESSEL_Y1' -- Bessel function of the second kind of order 1 ================================================================= _Description_: - `BESSEL_Y1(X)' computes the Bessel function of the second kind of - order 1 of X. This function is available under the name `BESY1' as + 'BESSEL_Y1(X)' computes the Bessel function of the second kind of + order 1 of X. This function is available under the name 'BESY1' as a GNU extension. _Standard_: @@ -7645,13 +8694,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = BESSEL_Y1(X)' + 'RESULT = BESSEL_Y1(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: - The return value is of type `REAL'. It has the same kind as X. + The return value is of type 'REAL'. It has the same kind as X. _Example_: program test_besy1 @@ -7660,22 +8709,22 @@ _Example_: end program test_besy1 _Specific names_: - Name Argument Return type Standard - `DBESY1(X)' `REAL(8) X' `REAL(8)' GNU extension + Name Argument Return type Standard + 'DBESY1(X)' 'REAL(8) X' 'REAL(8)' GNU extension File: gfortran.info, Node: BESSEL_YN, Next: BGE, Prev: BESSEL_Y1, Up: Intrinsic Procedures -9.41 `BESSEL_YN' -- Bessel function of the second kind +9.45 'BESSEL_YN' -- Bessel function of the second kind ====================================================== _Description_: - `BESSEL_YN(N, X)' computes the Bessel function of the second kind - of order N of X. This function is available under the name `BESYN' + 'BESSEL_YN(N, X)' computes the Bessel function of the second kind + of order N of X. This function is available under the name 'BESYN' as a GNU extension. If N and X are arrays, their ranks and shapes shall conform. - `BESSEL_YN(N1, N2, X)' returns an array with the Bessel functions + 'BESSEL_YN(N1, N2, X)' returns an array with the Bessel functions of the first kind of the orders N1 to N2. _Standard_: @@ -7683,24 +8732,24 @@ _Standard_: _Class_: Elemental function, except for the transformational function - `BESSEL_YN(N1, N2, X)' + 'BESSEL_YN(N1, N2, X)' _Syntax_: - `RESULT = BESSEL_YN(N, X)' - `RESULT = BESSEL_YN(N1, N2, X)' + 'RESULT = BESSEL_YN(N, X)' + 'RESULT = BESSEL_YN(N1, N2, X)' _Arguments_: - N Shall be a scalar or an array of type - `INTEGER' . - N1 Shall be a non-negative scalar of type - `INTEGER'. - N2 Shall be a non-negative scalar of type - `INTEGER'. - X Shall be a scalar or an array of type `REAL'; - for `BESSEL_YN(N1, N2, X)' it shall be scalar. + N Shall be a scalar or an array of type 'INTEGER' + . + N1 Shall be a non-negative scalar of type + 'INTEGER'. + N2 Shall be a non-negative scalar of type + 'INTEGER'. + X Shall be a scalar or an array of type 'REAL'; + for 'BESSEL_YN(N1, N2, X)' it shall be scalar. _Return value_: - The return value is a scalar of type `REAL'. It has the same kind + The return value is a scalar of type 'REAL'. It has the same kind as X. _Note_: @@ -7715,14 +8764,14 @@ _Example_: end program test_besyn _Specific names_: - Name Argument Return type Standard - `DBESYN(N,X)' `INTEGER N' `REAL(8)' GNU extension - `REAL(8) X' + Name Argument Return type Standard + 'DBESYN(N,X)' 'INTEGER N' 'REAL(8)' GNU extension + 'REAL(8) X' File: gfortran.info, Node: BGE, Next: BGT, Prev: BESSEL_YN, Up: Intrinsic Procedures -9.42 `BGE' -- Bitwise greater than or equal to +9.46 'BGE' -- Bitwise greater than or equal to ============================================== _Description_: @@ -7736,15 +8785,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = BGE(I, J)' + 'RESULT = BGE(I, J)' _Arguments_: - I Shall be of `INTEGER' type. - J Shall be of `INTEGER' type, and of the same - kind as I. + I Shall be of 'INTEGER' type. + J Shall be of 'INTEGER' type, and of the same kind + as I. _Return value_: - The return value is of type `LOGICAL' and of the default kind. + The return value is of type 'LOGICAL' and of the default kind. _See also_: *note BGT::, *note BLE::, *note BLT:: @@ -7752,7 +8801,7 @@ _See also_: File: gfortran.info, Node: BGT, Next: BIT_SIZE, Prev: BGE, Up: Intrinsic Procedures -9.43 `BGT' -- Bitwise greater than +9.47 'BGT' -- Bitwise greater than ================================== _Description_: @@ -7765,15 +8814,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = BGT(I, J)' + 'RESULT = BGT(I, J)' _Arguments_: - I Shall be of `INTEGER' type. - J Shall be of `INTEGER' type, and of the same - kind as I. + I Shall be of 'INTEGER' type. + J Shall be of 'INTEGER' type, and of the same kind + as I. _Return value_: - The return value is of type `LOGICAL' and of the default kind. + The return value is of type 'LOGICAL' and of the default kind. _See also_: *note BGE::, *note BLE::, *note BLT:: @@ -7781,13 +8830,13 @@ _See also_: File: gfortran.info, Node: BIT_SIZE, Next: BLE, Prev: BGT, Up: Intrinsic Procedures -9.44 `BIT_SIZE' -- Bit size inquiry function +9.48 'BIT_SIZE' -- Bit size inquiry function ============================================ _Description_: - `BIT_SIZE(I)' returns the number of bits (integer precision plus + 'BIT_SIZE(I)' returns the number of bits (integer precision plus sign bit) represented by the type of I. The result of - `BIT_SIZE(I)' is independent of the actual value of I. + 'BIT_SIZE(I)' is independent of the actual value of I. _Standard_: Fortran 95 and later @@ -7796,13 +8845,13 @@ _Class_: Inquiry function _Syntax_: - `RESULT = BIT_SIZE(I)' + 'RESULT = BIT_SIZE(I)' _Arguments_: - I The type shall be `INTEGER'. + I The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' + The return value is of type 'INTEGER' _Example_: program test_bit_size @@ -7815,7 +8864,7 @@ _Example_: File: gfortran.info, Node: BLE, Next: BLT, Prev: BIT_SIZE, Up: Intrinsic Procedures -9.45 `BLE' -- Bitwise less than or equal to +9.49 'BLE' -- Bitwise less than or equal to =========================================== _Description_: @@ -7829,15 +8878,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = BLE(I, J)' + 'RESULT = BLE(I, J)' _Arguments_: - I Shall be of `INTEGER' type. - J Shall be of `INTEGER' type, and of the same - kind as I. + I Shall be of 'INTEGER' type. + J Shall be of 'INTEGER' type, and of the same kind + as I. _Return value_: - The return value is of type `LOGICAL' and of the default kind. + The return value is of type 'LOGICAL' and of the default kind. _See also_: *note BGT::, *note BGE::, *note BLT:: @@ -7845,7 +8894,7 @@ _See also_: File: gfortran.info, Node: BLT, Next: BTEST, Prev: BLE, Up: Intrinsic Procedures -9.46 `BLT' -- Bitwise less than +9.50 'BLT' -- Bitwise less than =============================== _Description_: @@ -7858,15 +8907,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = BLT(I, J)' + 'RESULT = BLT(I, J)' _Arguments_: - I Shall be of `INTEGER' type. - J Shall be of `INTEGER' type, and of the same - kind as I. + I Shall be of 'INTEGER' type. + J Shall be of 'INTEGER' type, and of the same kind + as I. _Return value_: - The return value is of type `LOGICAL' and of the default kind. + The return value is of type 'LOGICAL' and of the default kind. _See also_: *note BGE::, *note BGT::, *note BLE:: @@ -7874,28 +8923,28 @@ _See also_: File: gfortran.info, Node: BTEST, Next: C_ASSOCIATED, Prev: BLT, Up: Intrinsic Procedures -9.47 `BTEST' -- Bit test function +9.51 'BTEST' -- Bit test function ================================= _Description_: - `BTEST(I,POS)' returns logical `.TRUE.' if the bit at POS in I is + 'BTEST(I,POS)' returns logical '.TRUE.' if the bit at POS in I is set. The counting of the bits starts at 0. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = BTEST(I, POS)' + 'RESULT = BTEST(I, POS)' _Arguments_: - I The type shall be `INTEGER'. - POS The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + POS The type shall be 'INTEGER'. _Return value_: - The return value is of type `LOGICAL' + The return value is of type 'LOGICAL' _Example_: program test_btest @@ -7908,14 +8957,27 @@ _Example_: end do end program test_btest +_Specific names_: + Name Argument Return type Standard + 'BTEST(I,POS)' 'INTEGER 'LOGICAL' F95 and later + I,POS' + 'BBTEST(I,POS)''INTEGER(1) 'LOGICAL(1)' GNU extension + I,POS' + 'BITEST(I,POS)''INTEGER(2) 'LOGICAL(2)' GNU extension + I,POS' + 'BJTEST(I,POS)''INTEGER(4) 'LOGICAL(4)' GNU extension + I,POS' + 'BKTEST(I,POS)''INTEGER(8) 'LOGICAL(8)' GNU extension + I,POS' + File: gfortran.info, Node: C_ASSOCIATED, Next: C_F_POINTER, Prev: BTEST, Up: Intrinsic Procedures -9.48 `C_ASSOCIATED' -- Status of a C pointer +9.52 'C_ASSOCIATED' -- Status of a C pointer ============================================ _Description_: - `C_ASSOCIATED(c_ptr_1[, c_ptr_2])' determines the status of the C + 'C_ASSOCIATED(c_ptr_1[, c_ptr_2])' determines the status of the C pointer C_PTR_1 or if C_PTR_1 is associated with the target C_PTR_2. @@ -7926,14 +8988,14 @@ _Class_: Inquiry function _Syntax_: - `RESULT = C_ASSOCIATED(c_ptr_1[, c_ptr_2])' + 'RESULT = C_ASSOCIATED(c_ptr_1[, c_ptr_2])' _Arguments_: - C_PTR_1 Scalar of the type `C_PTR' or `C_FUNPTR'. - C_PTR_2 (Optional) Scalar of the same type as C_PTR_1. + C_PTR_1 Scalar of the type 'C_PTR' or 'C_FUNPTR'. + C_PTR_2 (Optional) Scalar of the same type as C_PTR_1. _Return value_: - The return value is of type `LOGICAL'; it is `.false.' if either + The return value is of type 'LOGICAL'; it is '.false.' if either C_PTR_1 is a C NULL pointer or if C_PTR1 and C_PTR_2 point to different addresses. @@ -7953,11 +9015,11 @@ _See also_: File: gfortran.info, Node: C_F_POINTER, Next: C_F_PROCPOINTER, Prev: C_ASSOCIATED, Up: Intrinsic Procedures -9.49 `C_F_POINTER' -- Convert C into Fortran pointer +9.53 'C_F_POINTER' -- Convert C into Fortran pointer ==================================================== _Description_: - `C_F_POINTER(CPTR, FPTR[, SHAPE])' assigns the target of the C + 'C_F_POINTER(CPTR, FPTR[, SHAPE])' assigns the target of the C pointer CPTR to the Fortran pointer FPTR and specifies its shape. _Standard_: @@ -7967,16 +9029,16 @@ _Class_: Subroutine _Syntax_: - `CALL C_F_POINTER(CPTR, FPTR[, SHAPE])' + 'CALL C_F_POINTER(CPTR, FPTR[, SHAPE])' _Arguments_: - CPTR scalar of the type `C_PTR'. It is `INTENT(IN)'. - FPTR pointer interoperable with CPTR. It is - `INTENT(OUT)'. - SHAPE (Optional) Rank-one array of type `INTEGER' - with `INTENT(IN)'. It shall be present if and - only if FPTR is an array. The size must be - equal to the rank of FPTR. + CPTR scalar of the type 'C_PTR'. It is 'INTENT(IN)'. + FPTR pointer interoperable with CPTR. It is + 'INTENT(OUT)'. + SHAPE (Optional) Rank-one array of type 'INTEGER' with + 'INTENT(IN)'. It shall be present if and only + if FPTR is an array. The size must be equal to + the rank of FPTR. _Example_: program main @@ -8000,11 +9062,11 @@ _See also_: File: gfortran.info, Node: C_F_PROCPOINTER, Next: C_FUNLOC, Prev: C_F_POINTER, Up: Intrinsic Procedures -9.50 `C_F_PROCPOINTER' -- Convert C into Fortran procedure pointer +9.54 'C_F_PROCPOINTER' -- Convert C into Fortran procedure pointer ================================================================== _Description_: - `C_F_PROCPOINTER(CPTR, FPTR)' Assign the target of the C function + 'C_F_PROCPOINTER(CPTR, FPTR)' Assign the target of the C function pointer CPTR to the Fortran procedure pointer FPTR. _Standard_: @@ -8014,13 +9076,13 @@ _Class_: Subroutine _Syntax_: - `CALL C_F_PROCPOINTER(cptr, fptr)' + 'CALL C_F_PROCPOINTER(cptr, fptr)' _Arguments_: - CPTR scalar of the type `C_FUNPTR'. It is - `INTENT(IN)'. - FPTR procedure pointer interoperable with CPTR. It - is `INTENT(OUT)'. + CPTR scalar of the type 'C_FUNPTR'. It is + 'INTENT(IN)'. + FPTR procedure pointer interoperable with CPTR. It + is 'INTENT(OUT)'. _Example_: program main @@ -8051,11 +9113,11 @@ _See also_: File: gfortran.info, Node: C_FUNLOC, Next: C_LOC, Prev: C_F_PROCPOINTER, Up: Intrinsic Procedures -9.51 `C_FUNLOC' -- Obtain the C address of a procedure +9.55 'C_FUNLOC' -- Obtain the C address of a procedure ====================================================== _Description_: - `C_FUNLOC(x)' determines the C address of the argument. + 'C_FUNLOC(x)' determines the C address of the argument. _Standard_: Fortran 2003 and later @@ -8064,14 +9126,14 @@ _Class_: Inquiry function _Syntax_: - `RESULT = C_FUNLOC(x)' + 'RESULT = C_FUNLOC(x)' _Arguments_: - X Interoperable function or pointer to such - function. + X Interoperable function or pointer to such + function. _Return value_: - The return value is of type `C_FUNPTR' and contains the C address + The return value is of type 'C_FUNPTR' and contains the C address of the argument. _Example_: @@ -8104,11 +9166,11 @@ _See also_: File: gfortran.info, Node: C_LOC, Next: C_SIZEOF, Prev: C_FUNLOC, Up: Intrinsic Procedures -9.52 `C_LOC' -- Obtain the C address of an object +9.56 'C_LOC' -- Obtain the C address of an object ================================================= _Description_: - `C_LOC(X)' determines the C address of the argument. + 'C_LOC(X)' determines the C address of the argument. _Standard_: Fortran 2003 and later @@ -8117,18 +9179,18 @@ _Class_: Inquiry function _Syntax_: - `RESULT = C_LOC(X)' + 'RESULT = C_LOC(X)' _Arguments_: - X Shall have either the POINTER or TARGET - attribute. It shall not be a coindexed object. It - shall either be a variable with interoperable - type and kind type parameters, or be a scalar, - nonpolymorphic variable with no length type - parameters. + X Shall have either the POINTER or TARGET attribute. + It shall not be a coindexed object. It shall either + be a variable with interoperable type and kind type + parameters, or be a scalar, nonpolymorphic variable + with no length type parameters. + _Return value_: - The return value is of type `C_PTR' and contains the C address of + The return value is of type 'C_PTR' and contains the C address of the argument. _Example_: @@ -8148,33 +9210,33 @@ _See also_: File: gfortran.info, Node: C_SIZEOF, Next: CEILING, Prev: C_LOC, Up: Intrinsic Procedures -9.53 `C_SIZEOF' -- Size in bytes of an expression +9.57 'C_SIZEOF' -- Size in bytes of an expression ================================================= _Description_: - `C_SIZEOF(X)' calculates the number of bytes of storage the - expression `X' occupies. + 'C_SIZEOF(X)' calculates the number of bytes of storage the + expression 'X' occupies. _Standard_: Fortran 2008 _Class_: - Inquiry function of the module `ISO_C_BINDING' + Inquiry function of the module 'ISO_C_BINDING' _Syntax_: - `N = C_SIZEOF(X)' + 'N = C_SIZEOF(X)' _Arguments_: - X The argument shall be an interoperable data - entity. + X The argument shall be an interoperable data + entity. _Return value_: The return value is of type integer and of the system-dependent - kind `C_SIZE_T' (from the `ISO_C_BINDING' module). Its value is the - number of bytes occupied by the argument. If the argument has the - `POINTER' attribute, the number of bytes of the storage area + kind 'C_SIZE_T' (from the 'ISO_C_BINDING' module). Its value is + the number of bytes occupied by the argument. If the argument has + the 'POINTER' attribute, the number of bytes of the storage area pointed to is returned. If the argument is of a derived type with - `POINTER' or `ALLOCATABLE' components, the return value does not + 'POINTER' or 'ALLOCATABLE' components, the return value does not account for the sizes of the data pointed to by these components. _Example_: @@ -8183,8 +9245,8 @@ _Example_: real(c_float) :: r, s(5) print *, (c_sizeof(s)/c_sizeof(r) == 5) end - The example will print `.TRUE.' unless you are using a platform - where default `REAL' variables are unusually padded. + The example will print '.TRUE.' unless you are using a platform + where default 'REAL' variables are unusually padded. _See also_: *note SIZEOF::, *note STORAGE_SIZE:: @@ -8192,11 +9254,11 @@ _See also_: File: gfortran.info, Node: CEILING, Next: CHAR, Prev: C_SIZEOF, Up: Intrinsic Procedures -9.54 `CEILING' -- Integer ceiling function +9.58 'CEILING' -- Integer ceiling function ========================================== _Description_: - `CEILING(A)' returns the least integer greater than or equal to A. + 'CEILING(A)' returns the least integer greater than or equal to A. _Standard_: Fortran 95 and later @@ -8205,17 +9267,17 @@ _Class_: Elemental function _Syntax_: - `RESULT = CEILING(A [, KIND])' + 'RESULT = CEILING(A [, KIND])' _Arguments_: - A The type shall be `REAL'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + A The type shall be 'REAL'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER(KIND)' if KIND is present and - a default-kind `INTEGER' otherwise. + The return value is of type 'INTEGER(KIND)' if KIND is present and + a default-kind 'INTEGER' otherwise. _Example_: program test_ceiling @@ -8228,16 +9290,15 @@ _Example_: _See also_: *note FLOOR::, *note NINT:: - File: gfortran.info, Node: CHAR, Next: CHDIR, Prev: CEILING, Up: Intrinsic Procedures -9.55 `CHAR' -- Character conversion function +9.59 'CHAR' -- Character conversion function ============================================ _Description_: - `CHAR(I [, KIND])' returns the character represented by the - integer I. + 'CHAR(I [, KIND])' returns the character represented by the integer + I. _Standard_: Fortran 77 and later @@ -8246,16 +9307,16 @@ _Class_: Elemental function _Syntax_: - `RESULT = CHAR(I [, KIND])' + 'RESULT = CHAR(I [, KIND])' _Arguments_: - I The type shall be `INTEGER'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + I The type shall be 'INTEGER'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `CHARACTER(1)' + The return value is of type 'CHARACTER(1)' _Example_: program test_char @@ -8266,8 +9327,8 @@ _Example_: end program test_char _Specific names_: - Name Argument Return type Standard - `CHAR(I)' `INTEGER I' `CHARACTER(LEN=1)'F77 and later + Name Argument Return type Standard + 'CHAR(I)' 'INTEGER I' 'CHARACTER(LEN=1)'F77 and later _Note_: See *note ICHAR:: for a discussion of converting between numerical @@ -8276,11 +9337,10 @@ _Note_: _See also_: *note ACHAR::, *note IACHAR::, *note ICHAR:: - File: gfortran.info, Node: CHDIR, Next: CHMOD, Prev: CHAR, Up: Intrinsic Procedures -9.56 `CHDIR' -- Change working directory +9.60 'CHDIR' -- Change working directory ======================================== _Description_: @@ -8296,16 +9356,16 @@ _Class_: Subroutine, function _Syntax_: - `CALL CHDIR(NAME [, STATUS])' - `STATUS = CHDIR(NAME)' + 'CALL CHDIR(NAME [, STATUS])' + 'STATUS = CHDIR(NAME)' _Arguments_: - NAME The type shall be `CHARACTER' of default kind - and shall specify a valid path within the file - system. - STATUS (Optional) `INTEGER' status flag of the default - kind. Returns 0 on success, and a system - specific and nonzero error code otherwise. + NAME The type shall be 'CHARACTER' of default kind + and shall specify a valid path within the file + system. + STATUS (Optional) 'INTEGER' status flag of the default + kind. Returns 0 on success, and a system + specific and nonzero error code otherwise. _Example_: PROGRAM test_chdir @@ -8323,11 +9383,11 @@ _See also_: File: gfortran.info, Node: CHMOD, Next: CMPLX, Prev: CHDIR, Up: Intrinsic Procedures -9.57 `CHMOD' -- Change access permissions of files +9.61 'CHMOD' -- Change access permissions of files ================================================== _Description_: - `CHMOD' changes the permissions of a file. + 'CHMOD' changes the permissions of a file. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -8339,37 +9399,40 @@ _Class_: Subroutine, function _Syntax_: - `CALL CHMOD(NAME, MODE[, STATUS])' - `STATUS = CHMOD(NAME, MODE)' + 'CALL CHMOD(NAME, MODE[, STATUS])' + 'STATUS = CHMOD(NAME, MODE)' _Arguments_: - NAME Scalar `CHARACTER' of default kind with the - file name. Trailing blanks are ignored unless - the character `achar(0)' is present, then all - characters up to and excluding `achar(0)' are - used as the file name. - MODE Scalar `CHARACTER' of default kind giving the - file permission. MODE uses the same syntax as - the `chmod' utility as defined by the POSIX - standard. The argument shall either be a - string of a nonnegative octal number or a - symbolic mode. - STATUS (optional) scalar `INTEGER', which is `0' on - success and nonzero otherwise. + + NAME Scalar 'CHARACTER' of default kind with the file + name. Trailing blanks are ignored unless the + character 'achar(0)' is present, then all + characters up to and excluding 'achar(0)' are + used as the file name. + + MODE Scalar 'CHARACTER' of default kind giving the + file permission. MODE uses the same syntax as + the 'chmod' utility as defined by the POSIX + standard. The argument shall either be a string + of a nonnegative octal number or a symbolic + mode. + + STATUS (optional) scalar 'INTEGER', which is '0' on + success and nonzero otherwise. _Return value_: - In either syntax, STATUS is set to `0' on success and nonzero + In either syntax, STATUS is set to '0' on success and nonzero otherwise. _Example_: - `CHMOD' as subroutine + 'CHMOD' as subroutine program chmod_test implicit none integer :: status call chmod('test.dat','u+x',status) print *, 'Status: ', status end program chmod_test - `CHMOD' as function: + 'CHMOD' as function: program chmod_test implicit none integer :: status @@ -8377,19 +9440,18 @@ _Example_: print *, 'Status: ', status end program chmod_test - File: gfortran.info, Node: CMPLX, Next: CO_BROADCAST, Prev: CHMOD, Up: Intrinsic Procedures -9.58 `CMPLX' -- Complex conversion function +9.62 'CMPLX' -- Complex conversion function =========================================== _Description_: - `CMPLX(X [, Y [, KIND]])' returns a complex number where X is + 'CMPLX(X [, Y [, KIND]])' returns a complex number where X is converted to the real component. If Y is present it is converted - to the imaginary component. If Y is not present then the - imaginary component is set to 0.0. If X is complex then Y must - not be present. + to the imaginary component. If Y is not present then the imaginary + component is set to 0.0. If X is complex then Y must not be + present. _Standard_: Fortran 77 and later @@ -8398,21 +9460,20 @@ _Class_: Elemental function _Syntax_: - `RESULT = CMPLX(X [, Y [, KIND]])' + 'RESULT = CMPLX(X [, Y [, KIND]])' _Arguments_: - X The type may be `INTEGER', `REAL', or - `COMPLEX'. - Y (Optional; only allowed if X is not - `COMPLEX'.) May be `INTEGER' or `REAL'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + X The type may be 'INTEGER', 'REAL', or 'COMPLEX'. + Y (Optional; only allowed if X is not 'COMPLEX'.) + May be 'INTEGER' or 'REAL'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of `COMPLEX' type, with a kind equal to KIND - if it is specified. If KIND is not specified, the result is of - the default `COMPLEX' kind, regardless of the kinds of X and Y. + The return value is of 'COMPLEX' type, with a kind equal to KIND if + it is specified. If KIND is not specified, the result is of the + default 'COMPLEX' kind, regardless of the kinds of X and Y. _Example_: program test_cmplx @@ -8429,16 +9490,16 @@ _See also_: File: gfortran.info, Node: CO_BROADCAST, Next: CO_MAX, Prev: CMPLX, Up: Intrinsic Procedures -9.59 `CO_BROADCAST' -- Copy a value to all images the current set of images +9.63 'CO_BROADCAST' -- Copy a value to all images the current set of images =========================================================================== _Description_: - `CO_BROADCAST' copies the value of argument A on the image with - image index `SOURCE_IMAGE' to all images in the current team. A + 'CO_BROADCAST' copies the value of argument A on the image with + image index 'SOURCE_IMAGE' to all images in the current team. A becomes defined as if by intrinsic assignment. If the execution was successful and STAT is present, it is assigned the value zero. - If the execution failed, STAT gets assigned a nonzero value and, - if present, ERRMSG gets assigned a value describing the occurred + If the execution failed, STAT gets assigned a nonzero value and, if + present, ERRMSG gets assigned a value describing the occurred error. _Standard_: @@ -8448,18 +9509,18 @@ _Class_: Collective subroutine _Syntax_: - `CALL CO_BROADCAST(A, SOURCE_IMAGE [, STAT, ERRMSG])' + 'CALL CO_BROADCAST(A, SOURCE_IMAGE [, STAT, ERRMSG])' _Arguments_: - A INTENT(INOUT) argument; shall have the same - dynamic type and type paramters on all images - of the current team. If it is an array, it - shall have the same shape on all images. - SOURCE_IMAGEa scalar integer expression. It shall have - the same the same value on all images and - refer to an image of the current team. - STAT (optional) a scalar integer variable - ERRMSG (optional) a scalar character variable + A INTENT(INOUT) argument; shall have the same + dynamic type and type paramters on all images of + the current team. If it is an array, it shall + have the same shape on all images. + SOURCE_IMAGEa scalar integer expression. It shall have the + same the same value on all images and refer to + an image of the current team. + STAT (optional) a scalar integer variable + ERRMSG (optional) a scalar character variable _Example_: program test @@ -8477,19 +9538,19 @@ _See also_: File: gfortran.info, Node: CO_MAX, Next: CO_MIN, Prev: CO_BROADCAST, Up: Intrinsic Procedures -9.60 `CO_MAX' -- Maximal value on the current set of images +9.64 'CO_MAX' -- Maximal value on the current set of images =========================================================== _Description_: - `CO_MAX' determines element-wise the maximal value of A on all + 'CO_MAX' determines element-wise the maximal value of A on all images of the current team. If RESULT_IMAGE is present, the maximum values are returned in A on the specified image only and the value of A on the other images become undefined. If RESULT_IMAGE is not present, the value is returned on all images. - If the execution was successful and STAT is present, it is - assigned the value zero. If the execution failed, STAT gets - assigned a nonzero value and, if present, ERRMSG gets assigned a - value describing the occurred error. + If the execution was successful and STAT is present, it is assigned + the value zero. If the execution failed, STAT gets assigned a + nonzero value and, if present, ERRMSG gets assigned a value + describing the occurred error. _Standard_: Technical Specification (TS) 18508 or later @@ -8498,18 +9559,18 @@ _Class_: Collective subroutine _Syntax_: - `CALL CO_MAX(A [, RESULT_IMAGE, STAT, ERRMSG])' + 'CALL CO_MAX(A [, RESULT_IMAGE, STAT, ERRMSG])' _Arguments_: - A shall be an integer, real or character - variable, which has the same type and type - parameters on all images of the team. + A shall be an integer, real or character variable, + which has the same type and type parameters on + all images of the team. RESULT_IMAGE(optional) a scalar integer expression; if - present, it shall have the same the same value - on all images and refer to an image of the - current team. - STAT (optional) a scalar integer variable - ERRMSG (optional) a scalar character variable + present, it shall have the same the same value + on all images and refer to an image of the + current team. + STAT (optional) a scalar integer variable + ERRMSG (optional) a scalar character variable _Example_: program test @@ -8528,19 +9589,19 @@ _See also_: File: gfortran.info, Node: CO_MIN, Next: CO_REDUCE, Prev: CO_MAX, Up: Intrinsic Procedures -9.61 `CO_MIN' -- Minimal value on the current set of images +9.65 'CO_MIN' -- Minimal value on the current set of images =========================================================== _Description_: - `CO_MIN' determines element-wise the minimal value of A on all + 'CO_MIN' determines element-wise the minimal value of A on all images of the current team. If RESULT_IMAGE is present, the minimal values are returned in A on the specified image only and the value of A on the other images become undefined. If RESULT_IMAGE is not present, the value is returned on all images. - If the execution was successful and STAT is present, it is - assigned the value zero. If the execution failed, STAT gets - assigned a nonzero value and, if present, ERRMSG gets assigned a - value describing the occurred error. + If the execution was successful and STAT is present, it is assigned + the value zero. If the execution failed, STAT gets assigned a + nonzero value and, if present, ERRMSG gets assigned a value + describing the occurred error. _Standard_: Technical Specification (TS) 18508 or later @@ -8549,18 +9610,18 @@ _Class_: Collective subroutine _Syntax_: - `CALL CO_MIN(A [, RESULT_IMAGE, STAT, ERRMSG])' + 'CALL CO_MIN(A [, RESULT_IMAGE, STAT, ERRMSG])' _Arguments_: - A shall be an integer, real or character - variable, which has the same type and type - parameters on all images of the team. + A shall be an integer, real or character variable, + which has the same type and type parameters on + all images of the team. RESULT_IMAGE(optional) a scalar integer expression; if - present, it shall have the same the same value - on all images and refer to an image of the - current team. - STAT (optional) a scalar integer variable - ERRMSG (optional) a scalar character variable + present, it shall have the same the same value + on all images and refer to an image of the + current team. + STAT (optional) a scalar integer variable + ERRMSG (optional) a scalar character variable _Example_: program test @@ -8579,22 +9640,22 @@ _See also_: File: gfortran.info, Node: CO_REDUCE, Next: CO_SUM, Prev: CO_MIN, Up: Intrinsic Procedures -9.62 `CO_REDUCE' -- Reduction of values on the current set of images +9.66 'CO_REDUCE' -- Reduction of values on the current set of images ==================================================================== _Description_: - `CO_REDUCE' determines element-wise the reduction of the value of A + 'CO_REDUCE' determines element-wise the reduction of the value of A on all images of the current team. The pure function passed as OPERATOR is used to pairwise reduce the values of A by passing either the value of A of different images or the result values of such a reduction as argument. If A is an array, the deduction is - done element wise. If RESULT_IMAGE is present, the result values - are returned in A on the specified image only and the value of A - on the other images become undefined. If RESULT_IMAGE is not - present, the value is returned on all images. If the execution - was successful and STAT is present, it is assigned the value zero. - If the execution failed, STAT gets assigned a nonzero value and, - if present, ERRMSG gets assigned a value describing the occurred + done element wise. If RESULT_IMAGE is present, the result values + are returned in A on the specified image only and the value of A on + the other images become undefined. If RESULT_IMAGE is not present, + the value is returned on all images. If the execution was + successful and STAT is present, it is assigned the value zero. If + the execution failed, STAT gets assigned a nonzero value and, if + present, ERRMSG gets assigned a value describing the occurred error. _Standard_: @@ -8604,32 +9665,32 @@ _Class_: Collective subroutine _Syntax_: - `CALL CO_REDUCE(A, OPERATOR, [, RESULT_IMAGE, STAT, ERRMSG])' - -_Arguments_: - A is an `INTENT(INOUT)' argument and shall be - nonpolymorphic. If it is allocatable, it shall - be allocated; if it is a pointer, it shall be - associated. 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. - OPERATOR pure function with two scalar nonallocatable - arguments, which shall be nonpolymorphic and - have the same type and type parameters as A. - The function shall return a nonallocatable - scalar of the same type and type parameters as - A. The function shall be the same on all - images and with regards to the arguments - mathematically commutative and associative. - Note that OPERATOR may not be an elemental - function, unless it is an intrisic function. + 'CALL CO_REDUCE(A, OPERATOR, [, RESULT_IMAGE, STAT, ERRMSG])' + +_Arguments_: + A is an 'INTENT(INOUT)' argument and shall be + nonpolymorphic. If it is allocatable, it shall + be allocated; if it is a pointer, it shall be + associated. 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. + OPERATOR pure function with two scalar nonallocatable + arguments, which shall be nonpolymorphic and + have the same type and type parameters as A. + The function shall return a nonallocatable + scalar of the same type and type parameters as + A. The function shall be the same on all images + and with regards to the arguments mathematically + commutative and associative. Note that OPERATOR + may not be an elemental function, unless it is + an intrisic function. RESULT_IMAGE(optional) a scalar integer expression; if - present, it shall have the same the same value - on all images and refer to an image of the - current team. - STAT (optional) a scalar integer variable - ERRMSG (optional) a scalar character variable + present, it shall have the same the same value + on all images and refer to an image of the + current team. + STAT (optional) a scalar integer variable + ERRMSG (optional) a scalar character variable _Example_: program test @@ -8660,15 +9721,15 @@ _See also_: File: gfortran.info, Node: CO_SUM, Next: COMMAND_ARGUMENT_COUNT, Prev: CO_REDUCE, Up: Intrinsic Procedures -9.63 `CO_SUM' -- Sum of values on the current set of images +9.67 'CO_SUM' -- Sum of values on the current set of images =========================================================== _Description_: - `CO_SUM' sums up the values of each element of A on all images of - the current team. If RESULT_IMAGE is present, the summed-up - values are returned in A on the specified image only and the value - of A on the other images become undefined. If RESULT_IMAGE is not - present, the value is returned on all images. If the execution was + 'CO_SUM' sums up the values of each element of A on all images of + the current team. If RESULT_IMAGE is present, the summed-up values + are returned in A on the specified image only and the value of A on + the other images become undefined. If RESULT_IMAGE is not present, + the value is returned on all images. If the execution was successful and STAT is present, it is assigned the value zero. If the execution failed, STAT gets assigned a nonzero value and, if present, ERRMSG gets assigned a value describing the occurred @@ -8681,18 +9742,18 @@ _Class_: Collective subroutine _Syntax_: - `CALL CO_MIN(A [, RESULT_IMAGE, STAT, ERRMSG])' + 'CALL CO_MIN(A [, RESULT_IMAGE, STAT, ERRMSG])' _Arguments_: - A shall be an integer, real or complex variable, - which has the same type and type parameters on - all images of the team. + A shall be an integer, real or complex variable, + which has the same type and type parameters on + all images of the team. RESULT_IMAGE(optional) a scalar integer expression; if - present, it shall have the same the same value - on all images and refer to an image of the - current team. - STAT (optional) a scalar integer variable - ERRMSG (optional) a scalar character variable + present, it shall have the same the same value + on all images and refer to an image of the + current team. + STAT (optional) a scalar integer variable + ERRMSG (optional) a scalar character variable _Example_: program test @@ -8711,11 +9772,11 @@ _See also_: File: gfortran.info, Node: COMMAND_ARGUMENT_COUNT, Next: COMPILER_OPTIONS, Prev: CO_SUM, Up: Intrinsic Procedures -9.64 `COMMAND_ARGUMENT_COUNT' -- Get number of command line arguments +9.68 'COMMAND_ARGUMENT_COUNT' -- Get number of command line arguments ===================================================================== _Description_: - `COMMAND_ARGUMENT_COUNT' returns the number of arguments passed on + 'COMMAND_ARGUMENT_COUNT' returns the number of arguments passed on the command line when the containing program was invoked. _Standard_: @@ -8725,13 +9786,13 @@ _Class_: Inquiry function _Syntax_: - `RESULT = COMMAND_ARGUMENT_COUNT()' + 'RESULT = COMMAND_ARGUMENT_COUNT()' _Arguments_: - None + None _Return value_: - The return value is an `INTEGER' of default kind. + The return value is an 'INTEGER' of default kind. _Example_: program test_command_argument_count @@ -8746,21 +9807,21 @@ _See also_: File: gfortran.info, Node: COMPILER_OPTIONS, Next: COMPILER_VERSION, Prev: COMMAND_ARGUMENT_COUNT, Up: Intrinsic Procedures -9.65 `COMPILER_OPTIONS' -- Options passed to the compiler +9.69 'COMPILER_OPTIONS' -- Options passed to the compiler ========================================================= _Description_: - `COMPILER_OPTIONS' returns a string with the options used for + 'COMPILER_OPTIONS' returns a string with the options used for compiling. _Standard_: Fortran 2008 _Class_: - Inquiry function of the module `ISO_FORTRAN_ENV' + Inquiry function of the module 'ISO_FORTRAN_ENV' _Syntax_: - `STR = COMPILER_OPTIONS()' + 'STR = COMPILER_OPTIONS()' _Arguments_: None. @@ -8768,7 +9829,7 @@ _Arguments_: _Return value_: The return value is a default-kind string with system-dependent length. It contains the compiler flags used to compile the file, - which called the `COMPILER_OPTIONS' intrinsic. + which called the 'COMPILER_OPTIONS' intrinsic. _Example_: use iso_fortran_env @@ -8783,21 +9844,21 @@ _See also_: File: gfortran.info, Node: COMPILER_VERSION, Next: COMPLEX, Prev: COMPILER_OPTIONS, Up: Intrinsic Procedures -9.66 `COMPILER_VERSION' -- Compiler version string +9.70 'COMPILER_VERSION' -- Compiler version string ================================================== _Description_: - `COMPILER_VERSION' returns a string with the name and the version + 'COMPILER_VERSION' returns a string with the name and the version of the compiler. _Standard_: Fortran 2008 _Class_: - Inquiry function of the module `ISO_FORTRAN_ENV' + Inquiry function of the module 'ISO_FORTRAN_ENV' _Syntax_: - `STR = COMPILER_VERSION()' + 'STR = COMPILER_VERSION()' _Arguments_: None. @@ -8820,11 +9881,11 @@ _See also_: File: gfortran.info, Node: COMPLEX, Next: CONJG, Prev: COMPILER_VERSION, Up: Intrinsic Procedures -9.67 `COMPLEX' -- Complex conversion function +9.71 'COMPLEX' -- Complex conversion function ============================================= _Description_: - `COMPLEX(X, Y)' returns a complex number where X is converted to + 'COMPLEX(X, Y)' returns a complex number where X is converted to the real component and Y is converted to the imaginary component. _Standard_: @@ -8834,19 +9895,19 @@ _Class_: Elemental function _Syntax_: - `RESULT = COMPLEX(X, Y)' + 'RESULT = COMPLEX(X, Y)' _Arguments_: - X The type may be `INTEGER' or `REAL'. - Y The type may be `INTEGER' or `REAL'. + X The type may be 'INTEGER' or 'REAL'. + Y The type may be 'INTEGER' or 'REAL'. _Return value_: - If X and Y are both of `INTEGER' type, then the return value is of - default `COMPLEX' type. + If X and Y are both of 'INTEGER' type, then the return value is of + default 'COMPLEX' type. - If X and Y are of `REAL' type, or one is of `REAL' type and one is - of `INTEGER' type, then the return value is of `COMPLEX' type with - a kind equal to that of the `REAL' argument with the highest + If X and Y are of 'REAL' type, or one is of 'REAL' type and one is + of 'INTEGER' type, then the return value is of 'COMPLEX' type with + a kind equal to that of the 'REAL' argument with the highest precision. _Example_: @@ -8862,12 +9923,12 @@ _See also_: File: gfortran.info, Node: CONJG, Next: COS, Prev: COMPLEX, Up: Intrinsic Procedures -9.68 `CONJG' -- Complex conjugate function +9.72 'CONJG' -- Complex conjugate function ========================================== _Description_: - `CONJG(Z)' returns the conjugate of Z. If Z is `(x, y)' then the - result is `(x, -y)' + 'CONJG(Z)' returns the conjugate of Z. If Z is '(x, y)' then the + result is '(x, -y)' _Standard_: Fortran 77 and later, has overloads that are GNU extensions @@ -8876,13 +9937,13 @@ _Class_: Elemental function _Syntax_: - `Z = CONJG(Z)' + 'Z = CONJG(Z)' _Arguments_: - Z The type shall be `COMPLEX'. + Z The type shall be 'COMPLEX'. _Return value_: - The return value is of type `COMPLEX'. + The return value is of type 'COMPLEX'. _Example_: program test_conjg @@ -8895,19 +9956,19 @@ _Example_: end program test_conjg _Specific names_: - Name Argument Return type Standard - `CONJG(Z)' `COMPLEX Z' `COMPLEX' GNU extension - `DCONJG(Z)' `COMPLEX(8) `COMPLEX(8)' GNU extension - Z' + Name Argument Return type Standard + 'CONJG(Z)' 'COMPLEX Z' 'COMPLEX' GNU extension + 'DCONJG(Z)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + Z' -File: gfortran.info, Node: COS, Next: COSH, Prev: CONJG, Up: Intrinsic Procedures +File: gfortran.info, Node: COS, Next: COSD, Prev: CONJG, Up: Intrinsic Procedures -9.69 `COS' -- Cosine function +9.73 'COS' -- Cosine function ============================= _Description_: - `COS(X)' computes the cosine of X. + 'COS(X)' computes the cosine of X. _Standard_: Fortran 77 and later, has overloads that are GNU extensions @@ -8916,15 +9977,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = COS(X)' + 'RESULT = COS(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: - The return value is of the same type and kind as X. The real part - of the result is in radians. If X is of the type `REAL', the - return value lies in the range -1 \leq \cos (x) \leq 1. + The return value is of the same type and kind as X. The real part + of the result is in radians. If X is of the type 'REAL', the + return value lies in the range -1 \leq \cos (x) \leq 1. _Example_: program test_cos @@ -8933,30 +9994,78 @@ _Example_: end program test_cos _Specific names_: - Name Argument Return type Standard - `COS(X)' `REAL(4) X' `REAL(4)' Fortran 77 and - later - `DCOS(X)' `REAL(8) X' `REAL(8)' Fortran 77 and - later - `CCOS(X)' `COMPLEX(4) `COMPLEX(4)' Fortran 77 and - X' later - `ZCOS(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension - X' - `CDCOS(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension - X' + Name Argument Return type Standard + 'COS(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and + later + 'DCOS(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and + later + 'CCOS(X)' 'COMPLEX(4) 'COMPLEX(4)' Fortran 77 and + X' later + 'ZCOS(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + X' + 'CDCOS(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + X' _See also_: - Inverse function: *note ACOS:: + Inverse function: *note ACOS:: Degrees function: *note COSD:: + + +File: gfortran.info, Node: COSD, Next: COSH, Prev: COS, Up: Intrinsic Procedures + +9.74 'COSD' -- Cosine function, degrees +======================================= + +_Description_: + 'COSD(X)' computes the cosine of X in degrees. + + This function is for compatibility only and should be avoided in + favor of standard constructs wherever possible. + +_Standard_: + GNU Extension, enabled with '-fdec-math'. + +_Class_: + Elemental function + +_Syntax_: + 'RESULT = COSD(X)' + +_Arguments_: + X The type shall be 'REAL' or 'COMPLEX'. + +_Return value_: + The return value is of the same type and kind as X. The real part + of the result is in degrees. If X is of the type 'REAL', the + return value lies in the range -1 \leq \cosd (x) \leq 1. + +_Example_: + program test_cosd + real :: x = 0.0 + x = cosd(x) + end program test_cosd + +_Specific names_: + Name Argument Return type Standard + 'COSD(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DCOSD(X)' 'REAL(8) X' 'REAL(8)' GNU Extension + 'CCOSD(X)' 'COMPLEX(4) 'COMPLEX(4)' GNU Extension + X' + 'ZCOSD(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + X' + 'CDCOSD(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + X' +_See also_: + Inverse function: *note ACOSD:: Radians function: *note COS:: -File: gfortran.info, Node: COSH, Next: COUNT, Prev: COS, Up: Intrinsic Procedures +File: gfortran.info, Node: COSH, Next: COTAN, Prev: COSD, Up: Intrinsic Procedures -9.70 `COSH' -- Hyperbolic cosine function +9.75 'COSH' -- Hyperbolic cosine function ========================================= _Description_: - `COSH(X)' computes the hyperbolic cosine of X. + 'COSH(X)' computes the hyperbolic cosine of X. _Standard_: Fortran 77 and later, for a complex argument Fortran 2008 or later @@ -8965,14 +10074,14 @@ _Class_: Elemental function _Syntax_: - `X = COSH(X)' + 'X = COSH(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: - The return value has same type and kind as X. If X is complex, the - imaginary part of the result is in radians. If X is `REAL', the + The return value has same type and kind as X. If X is complex, the + imaginary part of the result is in radians. If X is 'REAL', the return value has a lower bound of one, \cosh (x) \geq 1. _Example_: @@ -8982,28 +10091,114 @@ _Example_: end program test_cosh _Specific names_: - Name Argument Return type Standard - `COSH(X)' `REAL(4) X' `REAL(4)' Fortran 77 and - later - `DCOSH(X)' `REAL(8) X' `REAL(8)' Fortran 77 and - later + Name Argument Return type Standard + 'COSH(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and + later + 'DCOSH(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and + later _See also_: Inverse function: *note ACOSH:: + +File: gfortran.info, Node: COTAN, Next: COTAND, Prev: COSH, Up: Intrinsic Procedures + +9.76 'COTAN' -- Cotangent function +================================== + +_Description_: + 'COTAN(X)' computes the cotangent of X. Equivalent to 'COS(x)' + divided by 'SIN(x)', or '1 / TAN(x)'. + + This function is for compatibility only and should be avoided in + favor of standard constructs wherever possible. + +_Standard_: + GNU Extension, enabled with '-fdec-math'. + +_Class_: + Elemental function + +_Syntax_: + 'RESULT = COTAN(X)' + +_Arguments_: + X The type shall be 'REAL' or 'COMPLEX'. + +_Return value_: + The return value has same type and kind as X, and its value is in + radians. + +_Example_: + program test_cotan + real(8) :: x = 0.165_8 + x = cotan(x) + end program test_cotan + +_Specific names_: + Name Argument Return type Standard + 'COTAN(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DCOTAN(X)' 'REAL(8) X' 'REAL(8)' GNU Extension + +_See also_: + Converse function: *note TAN:: Degrees function: *note COTAND:: -File: gfortran.info, Node: COUNT, Next: CPU_TIME, Prev: COSH, Up: Intrinsic Procedures +File: gfortran.info, Node: COTAND, Next: COUNT, Prev: COTAN, Up: Intrinsic Procedures + +9.77 'COTAND' -- Cotangent function, degrees +============================================ + +_Description_: + 'COTAND(X)' computes the cotangent of X in degrees. Equivalent to + 'COSD(x)' divided by 'SIND(x)', or '1 / TAND(x)'. + +_Standard_: + GNU Extension, enabled with '-fdec-math'. + + This function is for compatibility only and should be avoided in + favor of standard constructs wherever possible. -9.71 `COUNT' -- Count function +_Class_: + Elemental function + +_Syntax_: + 'RESULT = COTAND(X)' + +_Arguments_: + X The type shall be 'REAL' or 'COMPLEX'. + +_Return value_: + The return value has same type and kind as X, and its value is in + degrees. + +_Example_: + program test_cotand + real(8) :: x = 0.165_8 + x = cotand(x) + end program test_cotand + +_Specific names_: + Name Argument Return type Standard + 'COTAND(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DCOTAND(X)' 'REAL(8) X' 'REAL(8)' GNU Extension + +_See also_: + Converse function: *note TAND:: Radians function: *note COTAN:: + + +File: gfortran.info, Node: COUNT, Next: CPU_TIME, Prev: COTAND, Up: Intrinsic Procedures + +9.78 'COUNT' -- Count function ============================== _Description_: - Counts the number of `.TRUE.' elements in a logical MASK, or, if + + Counts the number of '.TRUE.' elements in a logical MASK, or, if the DIM argument is supplied, counts the number of elements along each row of the array in the DIM direction. If the array has zero - size, or all of the elements of MASK are `.FALSE.', then the - result is `0'. + size, or all of the elements of MASK are '.FALSE.', then the result + is '0'. _Standard_: Fortran 95 and later, with KIND argument Fortran 2003 and later @@ -9012,17 +10207,17 @@ _Class_: Transformational function _Syntax_: - `RESULT = COUNT(MASK [, DIM, KIND])' + 'RESULT = COUNT(MASK [, DIM, KIND])' _Arguments_: - MASK The type shall be `LOGICAL'. - DIM (Optional) The type shall be `INTEGER'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + MASK The type shall be 'LOGICAL'. + DIM (Optional) The type shall be 'INTEGER'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. If DIM is present, the result is an array with a rank one less than the rank of ARRAY, and a size corresponding to the shape of ARRAY with the @@ -9054,20 +10249,20 @@ _Example_: File: gfortran.info, Node: CPU_TIME, Next: CSHIFT, Prev: COUNT, Up: Intrinsic Procedures -9.72 `CPU_TIME' -- CPU elapsed time in seconds +9.79 'CPU_TIME' -- CPU elapsed time in seconds ============================================== _Description_: - Returns a `REAL' value representing the elapsed CPU time in + Returns a 'REAL' value representing the elapsed CPU time in seconds. This is useful for testing segments of code to determine execution time. If a time source is available, time will be reported with - microsecond resolution. If no time source is available, TIME is - set to `-1.0'. + microsecond resolution. If no time source is available, TIME is + set to '-1.0'. Note that TIME may contain a, system dependent, arbitrary offset - and may not start with `0.0'. For `CPU_TIME', the absolute value + and may not start with '0.0'. For 'CPU_TIME', the absolute value is meaningless, only differences between subsequent calls to this subroutine, as shown in the example below, should be used. @@ -9078,10 +10273,10 @@ _Class_: Subroutine _Syntax_: - `CALL CPU_TIME(TIME)' + 'CALL CPU_TIME(TIME)' _Arguments_: - TIME The type shall be `REAL' with `INTENT(OUT)'. + TIME The type shall be 'REAL' with 'INTENT(OUT)'. _Return value_: None @@ -9101,19 +10296,19 @@ _See also_: File: gfortran.info, Node: CSHIFT, Next: CTIME, Prev: CPU_TIME, Up: Intrinsic Procedures -9.73 `CSHIFT' -- Circular shift elements of an array +9.80 'CSHIFT' -- Circular shift elements of an array ==================================================== _Description_: - `CSHIFT(ARRAY, SHIFT [, DIM])' performs a circular shift on - elements of ARRAY along the dimension of DIM. If DIM is omitted - it is taken to be `1'. DIM is a scalar of type `INTEGER' in the - range of 1 \leq DIM \leq n) where n is the rank of ARRAY. If the - rank of ARRAY is one, then all elements of ARRAY are shifted by - SHIFT places. If rank is greater than one, then all complete rank - one sections of ARRAY along the given dimension are shifted. - Elements shifted out one end of each rank one section are shifted - back in the other end. + 'CSHIFT(ARRAY, SHIFT [, DIM])' performs a circular shift on + elements of ARRAY along the dimension of DIM. If DIM is omitted it + is taken to be '1'. DIM is a scalar of type 'INTEGER' in the range + of 1 \leq DIM \leq n) where n is the rank of ARRAY. If the rank of + ARRAY is one, then all elements of ARRAY are shifted by SHIFT + places. If rank is greater than one, then all complete rank one + sections of ARRAY along the given dimension are shifted. Elements + shifted out one end of each rank one section are shifted back in + the other end. _Standard_: Fortran 95 and later @@ -9122,12 +10317,12 @@ _Class_: Transformational function _Syntax_: - `RESULT = CSHIFT(ARRAY, SHIFT [, DIM])' + 'RESULT = CSHIFT(ARRAY, SHIFT [, DIM])' _Arguments_: - ARRAY Shall be an array of any type. - SHIFT The type shall be `INTEGER'. - DIM The type shall be `INTEGER'. + ARRAY Shall be an array of any type. + SHIFT The type shall be 'INTEGER'. + DIM The type shall be 'INTEGER'. _Return value_: Returns an array of same type and rank as the ARRAY argument. @@ -9149,13 +10344,13 @@ _Example_: File: gfortran.info, Node: CTIME, Next: DATE_AND_TIME, Prev: CSHIFT, Up: Intrinsic Procedures -9.74 `CTIME' -- Convert a time into a string +9.81 'CTIME' -- Convert a time into a string ============================================ _Description_: - `CTIME' converts a system time value, such as returned by `TIME8', - to a string. The output will be of the form `Sat Aug 19 18:13:14 - 1995'. + 'CTIME' converts a system time value, such as returned by *note + TIME8::, to a string. The output will be of the form 'Sat Aug 19 + 18:13:14 1995'. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -9167,17 +10362,16 @@ _Class_: Subroutine, function _Syntax_: - `CALL CTIME(TIME, RESULT)'. - `RESULT = CTIME(TIME)'. + 'CALL CTIME(TIME, RESULT)'. + 'RESULT = CTIME(TIME)'. _Arguments_: - TIME The type shall be of type `INTEGER'. - RESULT The type shall be of type `CHARACTER' and of - default kind. It is an `INTENT(OUT)' argument. - If the length of this variable is too short - for the time and date string to fit - completely, it will be blank on procedure - return. + TIME The type shall be of type 'INTEGER'. + RESULT The type shall be of type 'CHARACTER' and of + default kind. It is an 'INTENT(OUT)' argument. + If the length of this variable is too short for + the time and date string to fit completely, it + will be blank on procedure return. _Return value_: The converted date and time as a string. @@ -9195,35 +10389,35 @@ _Example_: end program test_ctime _See Also_: - *note DATE_AND_TIME::, *note GMTIME::, *note LTIME::, *note - TIME::, *note TIME8:: + *note DATE_AND_TIME::, *note GMTIME::, *note LTIME::, *note TIME::, + *note TIME8:: File: gfortran.info, Node: DATE_AND_TIME, Next: DBLE, Prev: CTIME, Up: Intrinsic Procedures -9.75 `DATE_AND_TIME' -- Date and time subroutine +9.82 'DATE_AND_TIME' -- Date and time subroutine ================================================ _Description_: - `DATE_AND_TIME(DATE, TIME, ZONE, VALUES)' gets the corresponding + 'DATE_AND_TIME(DATE, TIME, ZONE, VALUES)' gets the corresponding date and time information from the real-time system clock. DATE is - `INTENT(OUT)' and has form ccyymmdd. TIME is `INTENT(OUT)' and - has form hhmmss.sss. ZONE is `INTENT(OUT)' and has form (+-)hhmm, + 'INTENT(OUT)' and has form ccyymmdd. TIME is 'INTENT(OUT)' and has + form hhmmss.sss. ZONE is 'INTENT(OUT)' and has form (+-)hhmm, representing the difference with respect to Coordinated Universal - Time (UTC). Unavailable time and date parameters return blanks. + Time (UTC). Unavailable time and date parameters return blanks. - VALUES is `INTENT(OUT)' and provides the following: + VALUES is 'INTENT(OUT)' and provides the following: - `VALUE(1)': The year - `VALUE(2)': The month - `VALUE(3)': The day of the month - `VALUE(4)': Time difference with UTC - in minutes - `VALUE(5)': The hour of the day - `VALUE(6)': The minutes of the hour - `VALUE(7)': The seconds of the minute - `VALUE(8)': The milliseconds of the - second + 'VALUE(1)': The year + 'VALUE(2)': The month + 'VALUE(3)': The day of the month + 'VALUE(4)': Time difference with UTC in + minutes + 'VALUE(5)': The hour of the day + 'VALUE(6)': The minutes of the hour + 'VALUE(7)': The seconds of the minute + 'VALUE(8)': The milliseconds of the + second _Standard_: Fortran 95 and later @@ -9232,17 +10426,16 @@ _Class_: Subroutine _Syntax_: - `CALL DATE_AND_TIME([DATE, TIME, ZONE, VALUES])' + 'CALL DATE_AND_TIME([DATE, TIME, ZONE, VALUES])' _Arguments_: - DATE (Optional) The type shall be `CHARACTER(LEN=8)' - or larger, and of default kind. - TIME (Optional) The type shall be - `CHARACTER(LEN=10)' or larger, and of default - kind. - ZONE (Optional) The type shall be `CHARACTER(LEN=5)' - or larger, and of default kind. - VALUES (Optional) The type shall be `INTEGER(8)'. + DATE (Optional) The type shall be 'CHARACTER(LEN=8)' + or larger, and of default kind. + TIME (Optional) The type shall be 'CHARACTER(LEN=10)' + or larger, and of default kind. + ZONE (Optional) The type shall be 'CHARACTER(LEN=5)' + or larger, and of default kind. + VALUES (Optional) The type shall be 'INTEGER(8)'. _Return value_: None @@ -9268,11 +10461,11 @@ _See also_: File: gfortran.info, Node: DBLE, Next: DCMPLX, Prev: DATE_AND_TIME, Up: Intrinsic Procedures -9.76 `DBLE' -- Double conversion function +9.83 'DBLE' -- Double conversion function ========================================= _Description_: - `DBLE(A)' Converts A to double precision real type. + 'DBLE(A)' Converts A to double precision real type. _Standard_: Fortran 77 and later @@ -9281,11 +10474,11 @@ _Class_: Elemental function _Syntax_: - `RESULT = DBLE(A)' + 'RESULT = DBLE(A)' _Arguments_: - A The type shall be `INTEGER', `REAL', or - `COMPLEX'. + A The type shall be 'INTEGER', 'REAL', or + 'COMPLEX'. _Return value_: The return value is of type double precision real. @@ -9304,15 +10497,15 @@ _See also_: File: gfortran.info, Node: DCMPLX, Next: DIGITS, Prev: DBLE, Up: Intrinsic Procedures -9.77 `DCMPLX' -- Double complex conversion function +9.84 'DCMPLX' -- Double complex conversion function =================================================== _Description_: - `DCMPLX(X [,Y])' returns a double complex number where X is + 'DCMPLX(X [,Y])' returns a double complex number where X is converted to the real component. If Y is present it is converted - to the imaginary component. If Y is not present then the - imaginary component is set to 0.0. If X is complex then Y must - not be present. + to the imaginary component. If Y is not present then the imaginary + component is set to 0.0. If X is complex then Y must not be + present. _Standard_: GNU extension @@ -9321,16 +10514,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = DCMPLX(X [, Y])' + 'RESULT = DCMPLX(X [, Y])' _Arguments_: - X The type may be `INTEGER', `REAL', or - `COMPLEX'. - Y (Optional if X is not `COMPLEX'.) May be - `INTEGER' or `REAL'. + X The type may be 'INTEGER', 'REAL', or 'COMPLEX'. + Y (Optional if X is not 'COMPLEX'.) May be + 'INTEGER' or 'REAL'. _Return value_: - The return value is of type `COMPLEX(8)' + The return value is of type 'COMPLEX(8)' _Example_: program test_dcmplx @@ -9347,14 +10539,14 @@ _Example_: File: gfortran.info, Node: DIGITS, Next: DIM, Prev: DCMPLX, Up: Intrinsic Procedures -9.78 `DIGITS' -- Significant binary digits function +9.85 'DIGITS' -- Significant binary digits function =================================================== _Description_: - `DIGITS(X)' returns the number of significant binary digits of the - internal model representation of X. For example, on a system - using a 32-bit floating point representation, a default real - number would likely return 24. + 'DIGITS(X)' returns the number of significant binary digits of the + internal model representation of X. For example, on a system using + a 32-bit floating point representation, a default real number would + likely return 24. _Standard_: Fortran 95 and later @@ -9363,13 +10555,13 @@ _Class_: Inquiry function _Syntax_: - `RESULT = DIGITS(X)' + 'RESULT = DIGITS(X)' _Arguments_: - X The type may be `INTEGER' or `REAL'. + X The type may be 'INTEGER' or 'REAL'. _Return value_: - The return value is of type `INTEGER'. + The return value is of type 'INTEGER'. _Example_: program test_digits @@ -9384,11 +10576,11 @@ _Example_: File: gfortran.info, Node: DIM, Next: DOT_PRODUCT, Prev: DIGITS, Up: Intrinsic Procedures -9.79 `DIM' -- Positive difference +9.86 'DIM' -- Positive difference ================================= _Description_: - `DIM(X,Y)' returns the difference `X-Y' if the result is positive; + 'DIM(X,Y)' returns the difference 'X-Y' if the result is positive; otherwise returns zero. _Standard_: @@ -9398,14 +10590,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = DIM(X, Y)' + 'RESULT = DIM(X, Y)' _Arguments_: - X The type shall be `INTEGER' or `REAL' - Y The type shall be the same type and kind as X. + X The type shall be 'INTEGER' or 'REAL' + Y The type shall be the same type and kind as X. _Return value_: - The return value is of type `INTEGER' or `REAL'. + The return value is of type 'INTEGER' or 'REAL'. _Example_: program test_dim @@ -9418,29 +10610,28 @@ _Example_: end program test_dim _Specific names_: - Name Argument Return type Standard - `DIM(X,Y)' `REAL(4) X, `REAL(4)' Fortran 77 and - Y' later - `IDIM(X,Y)' `INTEGER(4) `INTEGER(4)' Fortran 77 and - X, Y' later - `DDIM(X,Y)' `REAL(8) X, `REAL(8)' Fortran 77 and - Y' later + Name Argument Return type Standard + 'DIM(X,Y)' 'REAL(4) X, 'REAL(4)' Fortran 77 and + Y' later + 'IDIM(X,Y)' 'INTEGER(4) 'INTEGER(4)' Fortran 77 and + X, Y' later + 'DDIM(X,Y)' 'REAL(8) X, 'REAL(8)' Fortran 77 and + Y' later File: gfortran.info, Node: DOT_PRODUCT, Next: DPROD, Prev: DIM, Up: Intrinsic Procedures -9.80 `DOT_PRODUCT' -- Dot product function +9.87 'DOT_PRODUCT' -- Dot product function ========================================== _Description_: - `DOT_PRODUCT(VECTOR_A, VECTOR_B)' computes the dot product + 'DOT_PRODUCT(VECTOR_A, VECTOR_B)' computes the dot product multiplication of two vectors VECTOR_A and VECTOR_B. The two - vectors may be either numeric or logical and must be arrays of - rank one and of equal size. If the vectors are `INTEGER' or - `REAL', the result is `SUM(VECTOR_A*VECTOR_B)'. If the vectors are - `COMPLEX', the result is `SUM(CONJG(VECTOR_A)*VECTOR_B)'. If the - vectors are `LOGICAL', the result is `ANY(VECTOR_A .AND. - VECTOR_B)'. + vectors may be either numeric or logical and must be arrays of rank + one and of equal size. If the vectors are 'INTEGER' or 'REAL', the + result is 'SUM(VECTOR_A*VECTOR_B)'. If the vectors are 'COMPLEX', + the result is 'SUM(CONJG(VECTOR_A)*VECTOR_B)'. If the vectors are + 'LOGICAL', the result is 'ANY(VECTOR_A .AND. VECTOR_B)'. _Standard_: Fortran 95 and later @@ -9449,19 +10640,18 @@ _Class_: Transformational function _Syntax_: - `RESULT = DOT_PRODUCT(VECTOR_A, VECTOR_B)' + 'RESULT = DOT_PRODUCT(VECTOR_A, VECTOR_B)' _Arguments_: - VECTOR_A The type shall be numeric or `LOGICAL', rank 1. - VECTOR_B The type shall be numeric if VECTOR_A is of - numeric type or `LOGICAL' if VECTOR_A is of - type `LOGICAL'. VECTOR_B shall be a rank-one - array. + VECTOR_A The type shall be numeric or 'LOGICAL', rank 1. + VECTOR_B The type shall be numeric if VECTOR_A is of + numeric type or 'LOGICAL' if VECTOR_A is of type + 'LOGICAL'. VECTOR_B shall be a rank-one array. _Return value_: If the arguments are numeric, the return value is a scalar of - numeric type, `INTEGER', `REAL', or `COMPLEX'. If the arguments - are `LOGICAL', the return value is `.TRUE.' or `.FALSE.'. + numeric type, 'INTEGER', 'REAL', or 'COMPLEX'. If the arguments + are 'LOGICAL', the return value is '.TRUE.' or '.FALSE.'. _Example_: program test_dot_prod @@ -9478,11 +10668,11 @@ _Example_: File: gfortran.info, Node: DPROD, Next: DREAL, Prev: DOT_PRODUCT, Up: Intrinsic Procedures -9.81 `DPROD' -- Double product function +9.88 'DPROD' -- Double product function ======================================= _Description_: - `DPROD(X,Y)' returns the product `X*Y'. + 'DPROD(X,Y)' returns the product 'X*Y'. _Standard_: Fortran 77 and later @@ -9491,14 +10681,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = DPROD(X, Y)' + 'RESULT = DPROD(X, Y)' _Arguments_: - X The type shall be `REAL'. - Y The type shall be `REAL'. + X The type shall be 'REAL'. + Y The type shall be 'REAL'. _Return value_: - The return value is of type `REAL(8)'. + The return value is of type 'REAL(8)'. _Example_: program test_dprod @@ -9510,19 +10700,18 @@ _Example_: end program test_dprod _Specific names_: - Name Argument Return type Standard - `DPROD(X,Y)' `REAL(4) X, `REAL(8)' Fortran 77 and - Y' later - + Name Argument Return type Standard + 'DPROD(X,Y)' 'REAL(4) X, 'REAL(8)' Fortran 77 and + Y' later File: gfortran.info, Node: DREAL, Next: DSHIFTL, Prev: DPROD, Up: Intrinsic Procedures -9.82 `DREAL' -- Double real part function +9.89 'DREAL' -- Double real part function ========================================= _Description_: - `DREAL(Z)' returns the real part of complex variable Z. + 'DREAL(Z)' returns the real part of complex variable Z. _Standard_: GNU extension @@ -9531,13 +10720,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = DREAL(A)' + 'RESULT = DREAL(A)' _Arguments_: - A The type shall be `COMPLEX(8)'. + A The type shall be 'COMPLEX(8)'. _Return value_: - The return value is of type `REAL(8)'. + The return value is of type 'REAL(8)'. _Example_: program test_dreal @@ -9548,15 +10737,14 @@ _Example_: _See also_: *note AIMAG:: - File: gfortran.info, Node: DSHIFTL, Next: DSHIFTR, Prev: DREAL, Up: Intrinsic Procedures -9.83 `DSHIFTL' -- Combined left shift +9.90 'DSHIFTL' -- Combined left shift ===================================== _Description_: - `DSHIFTL(I, J, SHIFT)' combines bits of I and J. The rightmost + 'DSHIFTL(I, J, SHIFT)' combines bits of I and J. The rightmost SHIFT bits of the result are the leftmost SHIFT bits of J, and the remaining bits are the rightmost bits of I. @@ -9567,23 +10755,23 @@ _Class_: Elemental function _Syntax_: - `RESULT = DSHIFTL(I, J, SHIFT)' + 'RESULT = DSHIFTL(I, J, SHIFT)' _Arguments_: - I Shall be of type `INTEGER' or a BOZ constant. - J Shall be of type `INTEGER' or a BOZ constant. - If both I and J have integer type, then they - shall have the same kind type parameter. I and - J shall not both be BOZ constants. - SHIFT Shall be of type `INTEGER'. It shall be - nonnegative. If I is not a BOZ constant, then - SHIFT shall be less than or equal to - `BIT_SIZE(I)'; otherwise, SHIFT shall be less - than or equal to `BIT_SIZE(J)'. + I Shall be of type 'INTEGER' or a BOZ constant. + J Shall be of type 'INTEGER' or a BOZ constant. + If both I and J have integer type, then they + shall have the same kind type parameter. I and + J shall not both be BOZ constants. + SHIFT Shall be of type 'INTEGER'. It shall be + nonnegative. If I is not a BOZ constant, then + SHIFT shall be less than or equal to + 'BIT_SIZE(I)'; otherwise, SHIFT shall be less + than or equal to 'BIT_SIZE(J)'. _Return value_: If either I or J is a BOZ constant, it is first converted as if by - the intrinsic function `INT' to an integer type with the kind type + the intrinsic function 'INT' to an integer type with the kind type parameter of the other. _See also_: @@ -9592,13 +10780,13 @@ _See also_: File: gfortran.info, Node: DSHIFTR, Next: DTIME, Prev: DSHIFTL, Up: Intrinsic Procedures -9.84 `DSHIFTR' -- Combined right shift +9.91 'DSHIFTR' -- Combined right shift ====================================== _Description_: - `DSHIFTR(I, J, SHIFT)' combines bits of I and J. The leftmost - SHIFT bits of the result are the rightmost SHIFT bits of I, and - the remaining bits are the leftmost bits of J. + 'DSHIFTR(I, J, SHIFT)' combines bits of I and J. The leftmost + SHIFT bits of the result are the rightmost SHIFT bits of I, and the + remaining bits are the leftmost bits of J. _Standard_: Fortran 2008 and later @@ -9607,23 +10795,23 @@ _Class_: Elemental function _Syntax_: - `RESULT = DSHIFTR(I, J, SHIFT)' + 'RESULT = DSHIFTR(I, J, SHIFT)' _Arguments_: - I Shall be of type `INTEGER' or a BOZ constant. - J Shall be of type `INTEGER' or a BOZ constant. - If both I and J have integer type, then they - shall have the same kind type parameter. I and - J shall not both be BOZ constants. - SHIFT Shall be of type `INTEGER'. It shall be - nonnegative. If I is not a BOZ constant, then - SHIFT shall be less than or equal to - `BIT_SIZE(I)'; otherwise, SHIFT shall be less - than or equal to `BIT_SIZE(J)'. + I Shall be of type 'INTEGER' or a BOZ constant. + J Shall be of type 'INTEGER' or a BOZ constant. + If both I and J have integer type, then they + shall have the same kind type parameter. I and + J shall not both be BOZ constants. + SHIFT Shall be of type 'INTEGER'. It shall be + nonnegative. If I is not a BOZ constant, then + SHIFT shall be less than or equal to + 'BIT_SIZE(I)'; otherwise, SHIFT shall be less + than or equal to 'BIT_SIZE(J)'. _Return value_: If either I or J is a BOZ constant, it is first converted as if by - the intrinsic function `INT' to an integer type with the kind type + the intrinsic function 'INT' to an integer type with the kind type parameter of the other. _See also_: @@ -9632,42 +10820,41 @@ _See also_: File: gfortran.info, Node: DTIME, Next: EOSHIFT, Prev: DSHIFTR, Up: Intrinsic Procedures -9.85 `DTIME' -- Execution time subroutine (or function) +9.92 'DTIME' -- Execution time subroutine (or function) ======================================================= _Description_: - `DTIME(VALUES, TIME)' initially returns the number of seconds of + 'DTIME(VALUES, TIME)' initially returns the number of seconds of runtime since the start of the process's execution in TIME. VALUES - returns the user and system components of this time in `VALUES(1)' - and `VALUES(2)' respectively. TIME is equal to `VALUES(1) + + returns the user and system components of this time in 'VALUES(1)' + and 'VALUES(2)' respectively. TIME is equal to 'VALUES(1) + VALUES(2)'. - Subsequent invocations of `DTIME' return values accumulated since + Subsequent invocations of 'DTIME' return values accumulated since the previous invocation. - On some systems, the underlying timings are represented using - types with sufficiently small limits that overflows (wrap around) - are possible, such as 32-bit types. Therefore, the values returned - by this intrinsic might be, or become, negative, or numerically - less than previous values, during a single run of the compiled - program. + On some systems, the underlying timings are represented using types + with sufficiently small limits that overflows (wrap around) are + possible, such as 32-bit types. Therefore, the values returned by + this intrinsic might be, or become, negative, or numerically less + than previous values, during a single run of the compiled program. - Please note, that this implementation is thread safe if used - within OpenMP directives, i.e., its state will be consistent while - called from multiple threads. However, if `DTIME' is called from - multiple threads, the result is still the time since the last - invocation. This may not give the intended results. If possible, - use `CPU_TIME' instead. + Please note, that this implementation is thread safe if used within + OpenMP directives, i.e., its state will be consistent while called + from multiple threads. However, if 'DTIME' is called from multiple + threads, the result is still the time since the last invocation. + This may not give the intended results. If possible, use + 'CPU_TIME' instead. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. - VALUES and TIME are `INTENT(OUT)' and provide the following: + VALUES and TIME are 'INTENT(OUT)' and provide the following: - `VALUES(1)': User time in seconds. - `VALUES(2)': System time in seconds. - `TIME': Run time since start in - seconds. + 'VALUES(1)': User time in seconds. + 'VALUES(2)': System time in seconds. + 'TIME': Run time since start in + seconds. _Standard_: GNU extension @@ -9676,12 +10863,12 @@ _Class_: Subroutine, function _Syntax_: - `CALL DTIME(VALUES, TIME)'. - `TIME = DTIME(VALUES)', (not recommended). + 'CALL DTIME(VALUES, TIME)'. + 'TIME = DTIME(VALUES)', (not recommended). _Arguments_: - VALUES The type shall be `REAL(4), DIMENSION(2)'. - TIME The type shall be `REAL(4)'. + VALUES The type shall be 'REAL(4), DIMENSION(2)'. + TIME The type shall be 'REAL(4)'. _Return value_: Elapsed time in seconds since the last invocation or since the @@ -9708,31 +10895,30 @@ _Example_: _See also_: *note CPU_TIME:: - File: gfortran.info, Node: EOSHIFT, Next: EPSILON, Prev: DTIME, Up: Intrinsic Procedures -9.86 `EOSHIFT' -- End-off shift elements of an array +9.93 'EOSHIFT' -- End-off shift elements of an array ==================================================== _Description_: - `EOSHIFT(ARRAY, SHIFT[, BOUNDARY, DIM])' performs an end-off shift - on elements of ARRAY along the dimension of DIM. If DIM is - omitted it is taken to be `1'. DIM is a scalar of type `INTEGER' - in the range of 1 \leq DIM \leq n) where n is the rank of ARRAY. - If the rank of ARRAY is one, then all elements of ARRAY are - shifted by SHIFT places. If rank is greater than one, then all - complete rank one sections of ARRAY along the given dimension are - shifted. Elements shifted out one end of each rank one section - are dropped. If BOUNDARY is present then the corresponding value - of from BOUNDARY is copied back in the other end. If BOUNDARY is - not present then the following are copied in depending on the type - of ARRAY. - - _Array _Boundary Value_ - Type_ - Numeric 0 of the type and kind of ARRAY. - Logical `.FALSE.'. + 'EOSHIFT(ARRAY, SHIFT[, BOUNDARY, DIM])' performs an end-off shift + on elements of ARRAY along the dimension of DIM. If DIM is omitted + it is taken to be '1'. DIM is a scalar of type 'INTEGER' in the + range of 1 \leq DIM \leq n) where n is the rank of ARRAY. If the + rank of ARRAY is one, then all elements of ARRAY are shifted by + SHIFT places. If rank is greater than one, then all complete rank + one sections of ARRAY along the given dimension are shifted. + Elements shifted out one end of each rank one section are dropped. + If BOUNDARY is present then the corresponding value of from + BOUNDARY is copied back in the other end. If BOUNDARY is not + present then the following are copied in depending on the type of + ARRAY. + + _Array _Boundary Value_ + Type_ + Numeric 0 of the type and kind of ARRAY. + Logical '.FALSE.'. Character(LEN)LEN blanks. _Standard_: @@ -9742,13 +10928,13 @@ _Class_: Transformational function _Syntax_: - `RESULT = EOSHIFT(ARRAY, SHIFT [, BOUNDARY, DIM])' + 'RESULT = EOSHIFT(ARRAY, SHIFT [, BOUNDARY, DIM])' _Arguments_: - ARRAY May be any type, not scalar. - SHIFT The type shall be `INTEGER'. - BOUNDARY Same type as ARRAY. - DIM The type shall be `INTEGER'. + ARRAY May be any type, not scalar. + SHIFT The type shall be 'INTEGER'. + BOUNDARY Same type as ARRAY. + DIM The type shall be 'INTEGER'. _Return value_: Returns an array of same type and rank as the ARRAY argument. @@ -9770,11 +10956,11 @@ _Example_: File: gfortran.info, Node: EPSILON, Next: ERF, Prev: EOSHIFT, Up: Intrinsic Procedures -9.87 `EPSILON' -- Epsilon function +9.94 'EPSILON' -- Epsilon function ================================== _Description_: - `EPSILON(X)' returns the smallest number E of the same kind as X + 'EPSILON(X)' returns the smallest number E of the same kind as X such that 1 + E > 1. _Standard_: @@ -9784,10 +10970,10 @@ _Class_: Inquiry function _Syntax_: - `RESULT = EPSILON(X)' + 'RESULT = EPSILON(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: The return value is of same type as the argument. @@ -9803,11 +10989,11 @@ _Example_: File: gfortran.info, Node: ERF, Next: ERFC, Prev: EPSILON, Up: Intrinsic Procedures -9.88 `ERF' -- Error function +9.95 'ERF' -- Error function ============================ _Description_: - `ERF(X)' computes the error function of X. + 'ERF(X)' computes the error function of X. _Standard_: Fortran 2008 and later @@ -9816,13 +11002,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = ERF(X)' + 'RESULT = ERF(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: - The return value is of type `REAL', of the same kind as X and lies + The return value is of type 'REAL', of the same kind as X and lies in the range -1 \leq erf (x) \leq 1 . _Example_: @@ -9832,17 +11018,17 @@ _Example_: end program test_erf _Specific names_: - Name Argument Return type Standard - `DERF(X)' `REAL(8) X' `REAL(8)' GNU extension + Name Argument Return type Standard + 'DERF(X)' 'REAL(8) X' 'REAL(8)' GNU extension File: gfortran.info, Node: ERFC, Next: ERFC_SCALED, Prev: ERF, Up: Intrinsic Procedures -9.89 `ERFC' -- Error function +9.96 'ERFC' -- Error function ============================= _Description_: - `ERFC(X)' computes the complementary error function of X. + 'ERFC(X)' computes the complementary error function of X. _Standard_: Fortran 2008 and later @@ -9851,14 +11037,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = ERFC(X)' + 'RESULT = ERFC(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: - The return value is of type `REAL' and of the same kind as X. It - lies in the range 0 \leq erfc (x) \leq 2 . + The return value is of type 'REAL' and of the same kind as X. It + lies in the range 0 \leq erfc (x) \leq 2 . _Example_: program test_erfc @@ -9867,17 +11053,17 @@ _Example_: end program test_erfc _Specific names_: - Name Argument Return type Standard - `DERFC(X)' `REAL(8) X' `REAL(8)' GNU extension + Name Argument Return type Standard + 'DERFC(X)' 'REAL(8) X' 'REAL(8)' GNU extension File: gfortran.info, Node: ERFC_SCALED, Next: ETIME, Prev: ERFC, Up: Intrinsic Procedures -9.90 `ERFC_SCALED' -- Error function +9.97 'ERFC_SCALED' -- Error function ==================================== _Description_: - `ERFC_SCALED(X)' computes the exponentially-scaled complementary + 'ERFC_SCALED(X)' computes the exponentially-scaled complementary error function of X. _Standard_: @@ -9887,13 +11073,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = ERFC_SCALED(X)' + 'RESULT = ERFC_SCALED(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: - The return value is of type `REAL' and of the same kind as X. + The return value is of type 'REAL' and of the same kind as X. _Example_: program test_erfc_scaled @@ -9904,31 +11090,30 @@ _Example_: File: gfortran.info, Node: ETIME, Next: EVENT_QUERY, Prev: ERFC_SCALED, Up: Intrinsic Procedures -9.91 `ETIME' -- Execution time subroutine (or function) +9.98 'ETIME' -- Execution time subroutine (or function) ======================================================= _Description_: - `ETIME(VALUES, TIME)' returns the number of seconds of runtime - since the start of the process's execution in TIME. VALUES - returns the user and system components of this time in `VALUES(1)' - and `VALUES(2)' respectively. TIME is equal to `VALUES(1) + + 'ETIME(VALUES, TIME)' returns the number of seconds of runtime + since the start of the process's execution in TIME. VALUES returns + the user and system components of this time in 'VALUES(1)' and + 'VALUES(2)' respectively. TIME is equal to 'VALUES(1) + VALUES(2)'. - On some systems, the underlying timings are represented using - types with sufficiently small limits that overflows (wrap around) - are possible, such as 32-bit types. Therefore, the values returned - by this intrinsic might be, or become, negative, or numerically - less than previous values, during a single run of the compiled - program. + On some systems, the underlying timings are represented using types + with sufficiently small limits that overflows (wrap around) are + possible, such as 32-bit types. Therefore, the values returned by + this intrinsic might be, or become, negative, or numerically less + than previous values, during a single run of the compiled program. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. - VALUES and TIME are `INTENT(OUT)' and provide the following: + VALUES and TIME are 'INTENT(OUT)' and provide the following: - `VALUES(1)': User time in seconds. - `VALUES(2)': System time in seconds. - `TIME': Run time since start in seconds. + 'VALUES(1)': User time in seconds. + 'VALUES(2)': System time in seconds. + 'TIME': Run time since start in seconds. _Standard_: GNU extension @@ -9937,12 +11122,12 @@ _Class_: Subroutine, function _Syntax_: - `CALL ETIME(VALUES, TIME)'. - `TIME = ETIME(VALUES)', (not recommended). + 'CALL ETIME(VALUES, TIME)'. + 'TIME = ETIME(VALUES)', (not recommended). _Arguments_: - VALUES The type shall be `REAL(4), DIMENSION(2)'. - TIME The type shall be `REAL(4)'. + VALUES The type shall be 'REAL(4), DIMENSION(2)'. + TIME The type shall be 'REAL(4)'. _Return value_: Elapsed time in seconds since the start of program execution. @@ -9968,20 +11153,19 @@ _Example_: _See also_: *note CPU_TIME:: - File: gfortran.info, Node: EVENT_QUERY, Next: EXECUTE_COMMAND_LINE, Prev: ETIME, Up: Intrinsic Procedures -9.92 `EVENT_QUERY' -- Query whether a coarray event has occurred +9.99 'EVENT_QUERY' -- Query whether a coarray event has occurred ================================================================ _Description_: - `EVENT_QUERY' assignes the number of events to COUNT which have + 'EVENT_QUERY' assignes the number of events to COUNT which have been posted to the EVENT variable and not yet been removed by - calling `EVENT WAIT'. When STAT is present and the invokation was - successful, it is assigned the value 0. If it is present and the - invokation has failed, it is assigned a positive value and COUNT - is assigned the value -1. + calling 'EVENT WAIT'. When STAT is present and the invocation was + successful, it is assigned the value 0. If it is present and the + invocation has failed, it is assigned a positive value and COUNT is + assigned the value -1. _Standard_: TS 18508 or later @@ -9990,16 +11174,15 @@ _Class_: subroutine _Syntax_: - `CALL EVENT_QUERY (EVENT, COUNT [, STAT])' + 'CALL EVENT_QUERY (EVENT, COUNT [, STAT])' _Arguments_: - EVENT (intent(IN)) Scalar of type `EVENT_TYPE', - defined in `ISO_FORTRAN_ENV'; shall not be - coindexed. - COUNT (intent(out))Scalar integer with at least the - precision of default integer. - STAT (optional) Scalar default-kind integer - variable. + EVENT (intent(IN)) Scalar of type 'EVENT_TYPE', + defined in 'ISO_FORTRAN_ENV'; shall not be + coindexed. + COUNT (intent(out))Scalar integer with at least the + precision of default integer. + STAT (optional) Scalar default-kind integer variable. _Example_: program atomic @@ -10015,33 +11198,31 @@ _Example_: end if end program atomic - File: gfortran.info, Node: EXECUTE_COMMAND_LINE, Next: EXIT, Prev: EVENT_QUERY, Up: Intrinsic Procedures -9.93 `EXECUTE_COMMAND_LINE' -- Execute a shell command -====================================================== +9.100 'EXECUTE_COMMAND_LINE' -- Execute a shell command +======================================================= _Description_: - `EXECUTE_COMMAND_LINE' runs a shell command, synchronously or + 'EXECUTE_COMMAND_LINE' runs a shell command, synchronously or asynchronously. - The `COMMAND' argument is passed to the shell and executed, using - the C library's `system' call. (The shell is `sh' on Unix - systems, and `cmd.exe' on Windows.) If `WAIT' is present and has - the value false, the execution of the command is asynchronous if - the system supports it; otherwise, the command is executed - synchronously. + The 'COMMAND' argument is passed to the shell and executed, using + the C library's 'system' call. (The shell is 'sh' on Unix systems, + and 'cmd.exe' on Windows.) If 'WAIT' is present and has the value + false, the execution of the command is asynchronous if the system + supports it; otherwise, the command is executed synchronously. The three last arguments allow the user to get status information. - After synchronous execution, `EXITSTAT' contains the integer exit - code of the command, as returned by `system'. `CMDSTAT' is set to + After synchronous execution, 'EXITSTAT' contains the integer exit + code of the command, as returned by 'system'. 'CMDSTAT' is set to zero if the command line was executed (whatever its exit status - was). `CMDMSG' is assigned an error message if an error has + was). 'CMDMSG' is assigned an error message if an error has occurred. - Note that the `system' function need not be thread-safe. It is the - responsibility of the user to ensure that `system' is not called + Note that the 'system' function need not be thread-safe. It is the + responsibility of the user to ensure that 'system' is not called concurrently. _Standard_: @@ -10051,18 +11232,18 @@ _Class_: Subroutine _Syntax_: - `CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, + 'CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])' _Arguments_: - COMMAND Shall be a default `CHARACTER' scalar. - WAIT (Optional) Shall be a default `LOGICAL' scalar. - EXITSTAT (Optional) Shall be an `INTEGER' of the - default kind. - CMDSTAT (Optional) Shall be an `INTEGER' of the - default kind. - CMDMSG (Optional) Shall be an `CHARACTER' scalar of - the default kind. + COMMAND Shall be a default 'CHARACTER' scalar. + WAIT (Optional) Shall be a default 'LOGICAL' scalar. + EXITSTAT (Optional) Shall be an 'INTEGER' of the default + kind. + CMDSTAT (Optional) Shall be an 'INTEGER' of the default + kind. + CMDMSG (Optional) Shall be an 'CHARACTER' scalar of the + default kind. _Example_: program test_exec @@ -10077,11 +11258,12 @@ _Example_: end program test_exec _Note_: - Because this intrinsic is implemented in terms of the `system' + + Because this intrinsic is implemented in terms of the 'system' function call, its behavior with respect to signaling is processor - dependent. In particular, on POSIX-compliant systems, the SIGINT + dependent. In particular, on POSIX-compliant systems, the SIGINT and SIGQUIT signals will be ignored, and the SIGCHLD will be - blocked. As such, if the parent process is terminated, the child + blocked. As such, if the parent process is terminated, the child process might not be terminated alongside. _See also_: @@ -10090,12 +11272,12 @@ _See also_: File: gfortran.info, Node: EXIT, Next: EXP, Prev: EXECUTE_COMMAND_LINE, Up: Intrinsic Procedures -9.94 `EXIT' -- Exit the program with status. -============================================ +9.101 'EXIT' -- Exit the program with status. +============================================= _Description_: - `EXIT' causes immediate termination of the program with status. - If status is omitted it returns the canonical _success_ for the + 'EXIT' causes immediate termination of the program with status. If + status is omitted it returns the canonical _success_ for the system. All Fortran I/O units are closed. _Standard_: @@ -10105,13 +11287,13 @@ _Class_: Subroutine _Syntax_: - `CALL EXIT([STATUS])' + 'CALL EXIT([STATUS])' _Arguments_: - STATUS Shall be an `INTEGER' of the default kind. + STATUS Shall be an 'INTEGER' of the default kind. _Return value_: - `STATUS' is passed to the parent process on exit. + 'STATUS' is passed to the parent process on exit. _Example_: program test_exit @@ -10126,11 +11308,11 @@ _See also_: File: gfortran.info, Node: EXP, Next: EXPONENT, Prev: EXIT, Up: Intrinsic Procedures -9.95 `EXP' -- Exponential function -================================== +9.102 'EXP' -- Exponential function +=================================== _Description_: - `EXP(X)' computes the base e exponential of X. + 'EXP(X)' computes the base e exponential of X. _Standard_: Fortran 77 and later, has overloads that are GNU extensions @@ -10139,10 +11321,10 @@ _Class_: Elemental function _Syntax_: - `RESULT = EXP(X)' + 'RESULT = EXP(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: The return value has same type and kind as X. @@ -10154,26 +11336,26 @@ _Example_: end program test_exp _Specific names_: - Name Argument Return type Standard - `EXP(X)' `REAL(4) X' `REAL(4)' Fortran 77 and - later - `DEXP(X)' `REAL(8) X' `REAL(8)' Fortran 77 and - later - `CEXP(X)' `COMPLEX(4) `COMPLEX(4)' Fortran 77 and - X' later - `ZEXP(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension - X' - `CDEXP(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension - X' + Name Argument Return type Standard + 'EXP(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and + later + 'DEXP(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and + later + 'CEXP(X)' 'COMPLEX(4) 'COMPLEX(4)' Fortran 77 and + X' later + 'ZEXP(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + X' + 'CDEXP(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + X' File: gfortran.info, Node: EXPONENT, Next: EXTENDS_TYPE_OF, Prev: EXP, Up: Intrinsic Procedures -9.96 `EXPONENT' -- Exponent function -==================================== +9.103 'EXPONENT' -- Exponent function +===================================== _Description_: - `EXPONENT(X)' returns the value of the exponent part of X. If X is + 'EXPONENT(X)' returns the value of the exponent part of X. If X is zero the value returned is zero. _Standard_: @@ -10183,13 +11365,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = EXPONENT(X)' + 'RESULT = EXPONENT(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: - The return value is of type default `INTEGER'. + The return value is of type default 'INTEGER'. _Example_: program test_exponent @@ -10203,7 +11385,7 @@ _Example_: File: gfortran.info, Node: EXTENDS_TYPE_OF, Next: FDATE, Prev: EXPONENT, Up: Intrinsic Procedures -9.97 `EXTENDS_TYPE_OF' -- Query dynamic type for extension +9.104 'EXTENDS_TYPE_OF' -- Query dynamic type for extension =========================================================== _Description_: @@ -10216,16 +11398,16 @@ _Class_: Inquiry function _Syntax_: - `RESULT = EXTENDS_TYPE_OF(A, MOLD)' + 'RESULT = EXTENDS_TYPE_OF(A, MOLD)' _Arguments_: - A Shall be an object of extensible declared type - or unlimited polymorphic. - MOLD Shall be an object of extensible declared type - or unlimited polymorphic. + A Shall be an object of extensible declared type + or unlimited polymorphic. + MOLD Shall be an object of extensible declared type + or unlimited polymorphic. _Return value_: - The return value is a scalar of type default logical. It is true + The return value is a scalar of type default logical. It is true if and only if the dynamic type of A is an extension type of the dynamic type of MOLD. @@ -10235,12 +11417,13 @@ _See also_: File: gfortran.info, Node: FDATE, Next: FGET, Prev: EXTENDS_TYPE_OF, Up: Intrinsic Procedures -9.98 `FDATE' -- Get the current time as a string -================================================ +9.105 'FDATE' -- Get the current time as a string +================================================= _Description_: - `FDATE(DATE)' returns the current date (using the same format as - `CTIME') in DATE. It is equivalent to `CALL CTIME(DATE, TIME())'. + 'FDATE(DATE)' returns the current date (using the same format as + *note CTIME::) in DATE. It is equivalent to 'CALL CTIME(DATE, + TIME())'. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -10252,16 +11435,15 @@ _Class_: Subroutine, function _Syntax_: - `CALL FDATE(DATE)'. - `DATE = FDATE()'. + 'CALL FDATE(DATE)'. + 'DATE = FDATE()'. _Arguments_: - DATE The type shall be of type `CHARACTER' of the - default kind. It is an `INTENT(OUT)' argument. - If the length of this variable is too short - for the date and time string to fit - completely, it will be blank on procedure - return. + DATE The type shall be of type 'CHARACTER' of the + default kind. It is an 'INTENT(OUT)' argument. + If the length of this variable is too short for + the date and time string to fit completely, it + will be blank on procedure return. _Return value_: The current date and time as a string. @@ -10285,23 +11467,23 @@ _See also_: File: gfortran.info, Node: FGET, Next: FGETC, Prev: FDATE, Up: Intrinsic Procedures -9.99 `FGET' -- Read a single character in stream mode from stdin -================================================================ +9.106 'FGET' -- Read a single character in stream mode from stdin +================================================================= _Description_: Read a single character in stream mode from stdin by bypassing - normal formatted output. Stream I/O should not be mixed with + normal formatted output. Stream I/O should not be mixed with normal record-oriented (formatted or unformatted) I/O on the same unit; the results are unpredictable. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. - Note that the `FGET' intrinsic is provided for backwards - compatibility with `g77'. GNU Fortran provides the Fortran 2003 - Stream facility. Programmers should consider the use of new - stream IO feature in new code for future portability. See also - *note Fortran 2003 status::. + Note that the 'FGET' intrinsic is provided for backwards + compatibility with 'g77'. GNU Fortran provides the Fortran 2003 + Stream facility. Programmers should consider the use of new stream + IO feature in new code for future portability. See also *note + Fortran 2003 status::. _Standard_: GNU extension @@ -10310,15 +11492,15 @@ _Class_: Subroutine, function _Syntax_: - `CALL FGET(C [, STATUS])' - `STATUS = FGET(C)' + 'CALL FGET(C [, STATUS])' + 'STATUS = FGET(C)' _Arguments_: - C The type shall be `CHARACTER' and of default - kind. - STATUS (Optional) status flag of type `INTEGER'. - Returns 0 on success, -1 on end-of-file, and a - system specific positive error code otherwise. + C The type shall be 'CHARACTER' and of default + kind. + STATUS (Optional) status flag of type 'INTEGER'. + Returns 0 on success, -1 on end-of-file, and a + system specific positive error code otherwise. _Example_: PROGRAM test_fget @@ -10341,7 +11523,7 @@ _See also_: File: gfortran.info, Node: FGETC, Next: FLOOR, Prev: FGET, Up: Intrinsic Procedures -9.100 `FGETC' -- Read a single character in stream mode +9.107 'FGETC' -- Read a single character in stream mode ======================================================= _Description_: @@ -10353,11 +11535,11 @@ _Description_: This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. - Note that the `FGET' intrinsic is provided for backwards - compatibility with `g77'. GNU Fortran provides the Fortran 2003 - Stream facility. Programmers should consider the use of new - stream IO feature in new code for future portability. See also - *note Fortran 2003 status::. + Note that the 'FGET' intrinsic is provided for backwards + compatibility with 'g77'. GNU Fortran provides the Fortran 2003 + Stream facility. Programmers should consider the use of new stream + IO feature in new code for future portability. See also *note + Fortran 2003 status::. _Standard_: GNU extension @@ -10366,16 +11548,16 @@ _Class_: Subroutine, function _Syntax_: - `CALL FGETC(UNIT, C [, STATUS])' - `STATUS = FGETC(UNIT, C)' + 'CALL FGETC(UNIT, C [, STATUS])' + 'STATUS = FGETC(UNIT, C)' _Arguments_: - UNIT The type shall be `INTEGER'. - C The type shall be `CHARACTER' and of default - kind. - STATUS (Optional) status flag of type `INTEGER'. - Returns 0 on success, -1 on end-of-file and a - system specific positive error code otherwise. + UNIT The type shall be 'INTEGER'. + C The type shall be 'CHARACTER' and of default + kind. + STATUS (Optional) status flag of type 'INTEGER'. + Returns 0 on success, -1 on end-of-file and a + system specific positive error code otherwise. _Example_: PROGRAM test_fgetc @@ -10397,11 +11579,11 @@ _See also_: File: gfortran.info, Node: FLOOR, Next: FLUSH, Prev: FGETC, Up: Intrinsic Procedures -9.101 `FLOOR' -- Integer floor function +9.108 'FLOOR' -- Integer floor function ======================================= _Description_: - `FLOOR(A)' returns the greatest integer less than or equal to X. + 'FLOOR(A)' returns the greatest integer less than or equal to X. _Standard_: Fortran 95 and later @@ -10410,17 +11592,17 @@ _Class_: Elemental function _Syntax_: - `RESULT = FLOOR(A [, KIND])' + 'RESULT = FLOOR(A [, KIND])' _Arguments_: - A The type shall be `REAL'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + A The type shall be 'REAL'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER(KIND)' if KIND is present and - of default-kind `INTEGER' otherwise. + The return value is of type 'INTEGER(KIND)' if KIND is present and + of default-kind 'INTEGER' otherwise. _Example_: program test_floor @@ -10433,15 +11615,14 @@ _Example_: _See also_: *note CEILING::, *note NINT:: - File: gfortran.info, Node: FLUSH, Next: FNUM, Prev: FLOOR, Up: Intrinsic Procedures -9.102 `FLUSH' -- Flush I/O unit(s) +9.109 'FLUSH' -- Flush I/O unit(s) ================================== _Description_: - Flushes Fortran unit(s) currently open for output. Without the + Flushes Fortran unit(s) currently open for output. Without the optional argument, all units are flushed, otherwise just the unit specified. @@ -10452,24 +11633,24 @@ _Class_: Subroutine _Syntax_: - `CALL FLUSH(UNIT)' + 'CALL FLUSH(UNIT)' _Arguments_: - UNIT (Optional) The type shall be `INTEGER'. + UNIT (Optional) The type shall be 'INTEGER'. _Note_: - Beginning with the Fortran 2003 standard, there is a `FLUSH' - statement that should be preferred over the `FLUSH' intrinsic. + Beginning with the Fortran 2003 standard, there is a 'FLUSH' + statement that should be preferred over the 'FLUSH' intrinsic. - The `FLUSH' intrinsic and the Fortran 2003 `FLUSH' statement have + The 'FLUSH' intrinsic and the Fortran 2003 'FLUSH' statement have identical effect: they flush the runtime library's I/O buffer so - that the data becomes visible to other processes. This does not + that the data becomes visible to other processes. This does not guarantee that the data is committed to disk. - On POSIX systems, you can request that all data is transferred to - the storage device by calling the `fsync' function, with the POSIX + On POSIX systems, you can request that all data is transferred to + the storage device by calling the 'fsync' function, with the POSIX file descriptor of the I/O unit as argument (retrieved with GNU - intrinsic `FNUM'). The following example shows how: + intrinsic 'FNUM'). The following example shows how: ! Declare the interface for POSIX fsync function interface @@ -10497,16 +11678,15 @@ _Note_: ! Handle possible error if (ret /= 0) stop "Error calling FSYNC" - File: gfortran.info, Node: FNUM, Next: FPUT, Prev: FLUSH, Up: Intrinsic Procedures -9.103 `FNUM' -- File number function +9.110 'FNUM' -- File number function ==================================== _Description_: - `FNUM(UNIT)' returns the POSIX file descriptor number - corresponding to the open Fortran I/O unit `UNIT'. + 'FNUM(UNIT)' returns the POSIX file descriptor number corresponding + to the open Fortran I/O unit 'UNIT'. _Standard_: GNU extension @@ -10515,13 +11695,13 @@ _Class_: Function _Syntax_: - `RESULT = FNUM(UNIT)' + 'RESULT = FNUM(UNIT)' _Arguments_: - UNIT The type shall be `INTEGER'. + UNIT The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' + The return value is of type 'INTEGER' _Example_: program test_fnum @@ -10535,23 +11715,23 @@ _Example_: File: gfortran.info, Node: FPUT, Next: FPUTC, Prev: FNUM, Up: Intrinsic Procedures -9.104 `FPUT' -- Write a single character in stream mode to stdout +9.111 'FPUT' -- Write a single character in stream mode to stdout ================================================================= _Description_: Write a single character in stream mode to stdout by bypassing - normal formatted output. Stream I/O should not be mixed with + normal formatted output. Stream I/O should not be mixed with normal record-oriented (formatted or unformatted) I/O on the same unit; the results are unpredictable. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. - Note that the `FGET' intrinsic is provided for backwards - compatibility with `g77'. GNU Fortran provides the Fortran 2003 - Stream facility. Programmers should consider the use of new - stream IO feature in new code for future portability. See also - *note Fortran 2003 status::. + Note that the 'FGET' intrinsic is provided for backwards + compatibility with 'g77'. GNU Fortran provides the Fortran 2003 + Stream facility. Programmers should consider the use of new stream + IO feature in new code for future portability. See also *note + Fortran 2003 status::. _Standard_: GNU extension @@ -10560,15 +11740,15 @@ _Class_: Subroutine, function _Syntax_: - `CALL FPUT(C [, STATUS])' - `STATUS = FPUT(C)' + 'CALL FPUT(C [, STATUS])' + 'STATUS = FPUT(C)' _Arguments_: - C The type shall be `CHARACTER' and of default - kind. - STATUS (Optional) status flag of type `INTEGER'. - Returns 0 on success, -1 on end-of-file and a - system specific positive error code otherwise. + C The type shall be 'CHARACTER' and of default + kind. + STATUS (Optional) status flag of type 'INTEGER'. + Returns 0 on success, -1 on end-of-file and a + system specific positive error code otherwise. _Example_: PROGRAM test_fput @@ -10585,23 +11765,23 @@ _See also_: File: gfortran.info, Node: FPUTC, Next: FRACTION, Prev: FPUT, Up: Intrinsic Procedures -9.105 `FPUTC' -- Write a single character in stream mode +9.112 'FPUTC' -- Write a single character in stream mode ======================================================== _Description_: Write a single character in stream mode by bypassing normal - formatted output. Stream I/O should not be mixed with normal + formatted output. Stream I/O should not be mixed with normal record-oriented (formatted or unformatted) I/O on the same unit; the results are unpredictable. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. - Note that the `FGET' intrinsic is provided for backwards - compatibility with `g77'. GNU Fortran provides the Fortran 2003 - Stream facility. Programmers should consider the use of new - stream IO feature in new code for future portability. See also - *note Fortran 2003 status::. + Note that the 'FGET' intrinsic is provided for backwards + compatibility with 'g77'. GNU Fortran provides the Fortran 2003 + Stream facility. Programmers should consider the use of new stream + IO feature in new code for future portability. See also *note + Fortran 2003 status::. _Standard_: GNU extension @@ -10610,16 +11790,16 @@ _Class_: Subroutine, function _Syntax_: - `CALL FPUTC(UNIT, C [, STATUS])' - `STATUS = FPUTC(UNIT, C)' + 'CALL FPUTC(UNIT, C [, STATUS])' + 'STATUS = FPUTC(UNIT, C)' _Arguments_: - UNIT The type shall be `INTEGER'. - C The type shall be `CHARACTER' and of default - kind. - STATUS (Optional) status flag of type `INTEGER'. - Returns 0 on success, -1 on end-of-file and a - system specific positive error code otherwise. + UNIT The type shall be 'INTEGER'. + C The type shall be 'CHARACTER' and of default + kind. + STATUS (Optional) status flag of type 'INTEGER'. + Returns 0 on success, -1 on end-of-file and a + system specific positive error code otherwise. _Example_: PROGRAM test_fputc @@ -10639,12 +11819,12 @@ _See also_: File: gfortran.info, Node: FRACTION, Next: FREE, Prev: FPUTC, Up: Intrinsic Procedures -9.106 `FRACTION' -- Fractional part of the model representation +9.113 'FRACTION' -- Fractional part of the model representation =============================================================== _Description_: - `FRACTION(X)' returns the fractional part of the model - representation of `X'. + 'FRACTION(X)' returns the fractional part of the model + representation of 'X'. _Standard_: Fortran 95 and later @@ -10653,15 +11833,15 @@ _Class_: Elemental function _Syntax_: - `Y = FRACTION(X)' + 'Y = FRACTION(X)' _Arguments_: - X The type of the argument shall be a `REAL'. + X The type of the argument shall be a 'REAL'. _Return value_: - The return value is of the same type and kind as the argument. - The fractional part of the model representation of `X' is returned; - it is `X * RADIX(X)**(-EXPONENT(X))'. + The return value is of the same type and kind as the argument. The + fractional part of the model representation of 'X' is returned; it + is 'X * RADIX(X)**(-EXPONENT(X))'. _Example_: program test_fraction @@ -10670,19 +11850,18 @@ _Example_: print *, fraction(x), x * radix(x)**(-exponent(x)) end program test_fraction - File: gfortran.info, Node: FREE, Next: FSEEK, Prev: FRACTION, Up: Intrinsic Procedures -9.107 `FREE' -- Frees memory +9.114 'FREE' -- Frees memory ============================ _Description_: - Frees memory previously allocated by `MALLOC'. The `FREE' + Frees memory previously allocated by 'MALLOC'. The 'FREE' intrinsic is an extension intended to be used with Cray pointers, and is provided in GNU Fortran to allow user to compile legacy - code. For new code using Fortran 95 pointers, the memory - de-allocation intrinsic is `DEALLOCATE'. + code. For new code using Fortran 95 pointers, the memory + de-allocation intrinsic is 'DEALLOCATE'. _Standard_: GNU extension @@ -10691,18 +11870,18 @@ _Class_: Subroutine _Syntax_: - `CALL FREE(PTR)' + 'CALL FREE(PTR)' _Arguments_: - PTR The type shall be `INTEGER'. It represents the - location of the memory that should be - de-allocated. + PTR The type shall be 'INTEGER'. It represents the + location of the memory that should be + de-allocated. _Return value_: None _Example_: - See `MALLOC' for an example. + See 'MALLOC' for an example. _See also_: *note MALLOC:: @@ -10710,20 +11889,20 @@ _See also_: File: gfortran.info, Node: FSEEK, Next: FSTAT, Prev: FREE, Up: Intrinsic Procedures -9.108 `FSEEK' -- Low level file positioning subroutine +9.115 'FSEEK' -- Low level file positioning subroutine ====================================================== _Description_: - Moves UNIT to the specified OFFSET. If WHENCE is set to 0, the - OFFSET is taken as an absolute value `SEEK_SET', if set to 1, - OFFSET is taken to be relative to the current position `SEEK_CUR', - and if set to 2 relative to the end of the file `SEEK_END'. On - error, STATUS is set to a nonzero value. If STATUS the seek fails + Moves UNIT to the specified OFFSET. If WHENCE is set to 0, the + OFFSET is taken as an absolute value 'SEEK_SET', if set to 1, + OFFSET is taken to be relative to the current position 'SEEK_CUR', + and if set to 2 relative to the end of the file 'SEEK_END'. On + error, STATUS is set to a nonzero value. If STATUS the seek fails silently. This intrinsic routine is not fully backwards compatible with - `g77'. In `g77', the `FSEEK' takes a statement label instead of a - STATUS variable. If FSEEK is used in old code, change + 'g77'. In 'g77', the 'FSEEK' takes a statement label instead of a + STATUS variable. If FSEEK is used in old code, change CALL FSEEK(UNIT, OFFSET, WHENCE, *label) to INTEGER :: status @@ -10732,7 +11911,7 @@ _Description_: Please note that GNU Fortran provides the Fortran 2003 Stream facility. Programmers should consider the use of new stream IO - feature in new code for future portability. See also *note Fortran + feature in new code for future portability. See also *note Fortran 2003 status::. _Standard_: @@ -10742,15 +11921,15 @@ _Class_: Subroutine _Syntax_: - `CALL FSEEK(UNIT, OFFSET, WHENCE[, STATUS])' + 'CALL FSEEK(UNIT, OFFSET, WHENCE[, STATUS])' _Arguments_: - UNIT Shall be a scalar of type `INTEGER'. - OFFSET Shall be a scalar of type `INTEGER'. - WHENCE Shall be a scalar of type `INTEGER'. Its - value shall be either 0, 1 or 2. - STATUS (Optional) shall be a scalar of type - `INTEGER(4)'. + UNIT Shall be a scalar of type 'INTEGER'. + OFFSET Shall be a scalar of type 'INTEGER'. + WHENCE Shall be a scalar of type 'INTEGER'. Its value + shall be either 0, 1 or 2. + STATUS (Optional) shall be a scalar of type + 'INTEGER(4)'. _Example_: PROGRAM test_fseek @@ -10780,14 +11959,14 @@ _See also_: File: gfortran.info, Node: FSTAT, Next: FTELL, Prev: FSEEK, Up: Intrinsic Procedures -9.109 `FSTAT' -- Get file status +9.116 'FSTAT' -- Get file status ================================ _Description_: - `FSTAT' is identical to *note STAT::, except that information - about an already opened file is obtained. + 'FSTAT' is identical to *note STAT::, except that information about + an already opened file is obtained. - The elements in `VALUES' are the same as described by *note STAT::. + The elements in 'VALUES' are the same as described by *note STAT::. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -10799,15 +11978,15 @@ _Class_: Subroutine, function _Syntax_: - `CALL FSTAT(UNIT, VALUES [, STATUS])' - `STATUS = FSTAT(UNIT, VALUES)' + 'CALL FSTAT(UNIT, VALUES [, STATUS])' + 'STATUS = FSTAT(UNIT, VALUES)' _Arguments_: - UNIT An open I/O unit number of type `INTEGER'. - VALUES The type shall be `INTEGER(4), DIMENSION(13)'. - STATUS (Optional) status flag of type `INTEGER(4)'. - Returns 0 on success and a system specific - error code otherwise. + UNIT An open I/O unit number of type 'INTEGER'. + VALUES The type shall be 'INTEGER(4), DIMENSION(13)'. + STATUS (Optional) status flag of type 'INTEGER(4)'. + Returns 0 on success and a system specific error + code otherwise. _Example_: See *note STAT:: for an example. @@ -10818,7 +11997,7 @@ _See also_: File: gfortran.info, Node: FTELL, Next: GAMMA, Prev: FSTAT, Up: Intrinsic Procedures -9.110 `FTELL' -- Current stream position +9.117 'FTELL' -- Current stream position ======================================== _Description_: @@ -10834,12 +12013,12 @@ _Class_: Subroutine, function _Syntax_: - `CALL FTELL(UNIT, OFFSET)' - `OFFSET = FTELL(UNIT)' + 'CALL FTELL(UNIT, OFFSET)' + 'OFFSET = FTELL(UNIT)' _Arguments_: - OFFSET Shall of type `INTEGER'. - UNIT Shall of type `INTEGER'. + OFFSET Shall of type 'INTEGER'. + UNIT Shall of type 'INTEGER'. _Return value_: In either syntax, OFFSET is set to the current offset of unit @@ -10859,13 +12038,13 @@ _See also_: File: gfortran.info, Node: GAMMA, Next: GERROR, Prev: FTELL, Up: Intrinsic Procedures -9.111 `GAMMA' -- Gamma function +9.118 'GAMMA' -- Gamma function =============================== _Description_: - `GAMMA(X)' computes Gamma (\Gamma) of X. For positive, integer - values of X the Gamma function simplifies to the factorial - function \Gamma(x)=(x-1)!. + 'GAMMA(X)' computes Gamma (\Gamma) of X. For positive, integer + values of X the Gamma function simplifies to the factorial function + \Gamma(x)=(x-1)!. _Standard_: Fortran 2008 and later @@ -10874,14 +12053,14 @@ _Class_: Elemental function _Syntax_: - `X = GAMMA(X)' + 'X = GAMMA(X)' _Arguments_: - X Shall be of type `REAL' and neither zero nor a - negative integer. + X Shall be of type 'REAL' and neither zero nor a + negative integer. _Return value_: - The return value is of type `REAL' of the same kind as X. + The return value is of type 'REAL' of the same kind as X. _Example_: program test_gamma @@ -10890,23 +12069,22 @@ _Example_: end program test_gamma _Specific names_: - Name Argument Return type Standard - `GAMMA(X)' `REAL(4) X' `REAL(4)' GNU Extension - `DGAMMA(X)' `REAL(8) X' `REAL(8)' GNU Extension + Name Argument Return type Standard + 'GAMMA(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DGAMMA(X)' 'REAL(8) X' 'REAL(8)' GNU Extension _See also_: Logarithm of the Gamma function: *note LOG_GAMMA:: - File: gfortran.info, Node: GERROR, Next: GETARG, Prev: GAMMA, Up: Intrinsic Procedures -9.112 `GERROR' -- Get last system error message +9.119 'GERROR' -- Get last system error message =============================================== _Description_: Returns the system error message corresponding to the last system - error. This resembles the functionality of `strerror(3)' in C. + error. This resembles the functionality of 'strerror(3)' in C. _Standard_: GNU extension @@ -10915,10 +12093,10 @@ _Class_: Subroutine _Syntax_: - `CALL GERROR(RESULT)' + 'CALL GERROR(RESULT)' _Arguments_: - RESULT Shall of type `CHARACTER' and of default + RESULT Shall of type 'CHARACTER' and of default _Example_: PROGRAM test_gerror @@ -10933,7 +12111,7 @@ _See also_: File: gfortran.info, Node: GETARG, Next: GET_COMMAND, Prev: GERROR, Up: Intrinsic Procedures -9.113 `GETARG' -- Get command line arguments +9.120 'GETARG' -- Get command line arguments ============================================ _Description_: @@ -10952,19 +12130,19 @@ _Class_: Subroutine _Syntax_: - `CALL GETARG(POS, VALUE)' + 'CALL GETARG(POS, VALUE)' _Arguments_: - POS Shall be of type `INTEGER' and not wider than - the default integer kind; POS \geq 0 - VALUE Shall be of type `CHARACTER' and of default - kind. - VALUE Shall be of type `CHARACTER'. + POS Shall be of type 'INTEGER' and not wider than + the default integer kind; POS \geq 0 + VALUE Shall be of type 'CHARACTER' and of default + kind. + VALUE Shall be of type 'CHARACTER'. _Return value_: - After `GETARG' returns, the VALUE argument holds the POSth command - line argument. If VALUE can not hold the argument, it is truncated - to fit the length of VALUE. If there are less than POS arguments + After 'GETARG' returns, the VALUE argument holds the POSth command + line argument. If VALUE can not hold the argument, it is truncated + to fit the length of VALUE. If there are less than POS arguments specified at the command line, VALUE will be filled with blanks. If POS = 0, VALUE is set to the name of the program (on systems that support this feature). @@ -10989,7 +12167,7 @@ _See also_: File: gfortran.info, Node: GET_COMMAND, Next: GET_COMMAND_ARGUMENT, Prev: GETARG, Up: Intrinsic Procedures -9.114 `GET_COMMAND' -- Get the entire command line +9.121 'GET_COMMAND' -- Get the entire command line ================================================== _Description_: @@ -11003,20 +12181,20 @@ _Class_: Subroutine _Syntax_: - `CALL GET_COMMAND([COMMAND, LENGTH, STATUS])' + 'CALL GET_COMMAND([COMMAND, LENGTH, STATUS])' _Arguments_: - COMMAND (Optional) shall be of type `CHARACTER' and of - default kind. - LENGTH (Optional) Shall be of type `INTEGER' and of - default kind. - STATUS (Optional) Shall be of type `INTEGER' and of - default kind. + COMMAND (Optional) shall be of type 'CHARACTER' and of + default kind. + LENGTH (Optional) Shall be of type 'INTEGER' and of + default kind. + STATUS (Optional) Shall be of type 'INTEGER' and of + default kind. _Return value_: If COMMAND is present, stores the entire command line that was used - to invoke the program in COMMAND. If LENGTH is present, it is - assigned the length of the command line. If STATUS is present, it + to invoke the program in COMMAND. If LENGTH is present, it is + assigned the length of the command line. If STATUS is present, it is assigned 0 upon success of the command, -1 if COMMAND is too short to store the command line, or a positive value in case of an error. @@ -11034,12 +12212,12 @@ _See also_: File: gfortran.info, Node: GET_COMMAND_ARGUMENT, Next: GETCWD, Prev: GET_COMMAND, Up: Intrinsic Procedures -9.115 `GET_COMMAND_ARGUMENT' -- Get command line arguments +9.122 'GET_COMMAND_ARGUMENT' -- Get command line arguments ========================================================== _Description_: - Retrieve the NUMBER-th argument that was passed on the command - line when the containing program was invoked. + Retrieve the NUMBER-th argument that was passed on the command line + when the containing program was invoked. _Standard_: Fortran 2003 and later @@ -11048,29 +12226,29 @@ _Class_: Subroutine _Syntax_: - `CALL GET_COMMAND_ARGUMENT(NUMBER [, VALUE, LENGTH, STATUS])' + 'CALL GET_COMMAND_ARGUMENT(NUMBER [, VALUE, LENGTH, STATUS])' _Arguments_: - NUMBER Shall be a scalar of type `INTEGER' and of - default kind, NUMBER \geq 0 - VALUE (Optional) Shall be a scalar of type - `CHARACTER' and of default kind. - LENGTH (Optional) Shall be a scalar of type `INTEGER' - and of default kind. - STATUS (Optional) Shall be a scalar of type `INTEGER' - and of default kind. + NUMBER Shall be a scalar of type 'INTEGER' and of + default kind, NUMBER \geq 0 + VALUE (Optional) Shall be a scalar of type 'CHARACTER' + and of default kind. + LENGTH (Optional) Shall be a scalar of type 'INTEGER' + and of default kind. + STATUS (Optional) Shall be a scalar of type 'INTEGER' + and of default kind. _Return value_: - After `GET_COMMAND_ARGUMENT' returns, the VALUE argument holds the - NUMBER-th command line argument. If VALUE can not hold the - argument, it is truncated to fit the length of VALUE. If there are + After 'GET_COMMAND_ARGUMENT' returns, the VALUE argument holds the + NUMBER-th command line argument. If VALUE can not hold the + argument, it is truncated to fit the length of VALUE. If there are less than NUMBER arguments specified at the command line, VALUE will be filled with blanks. If NUMBER = 0, VALUE is set to the - name of the program (on systems that support this feature). The + name of the program (on systems that support this feature). The LENGTH argument contains the length of the NUMBER-th command line - argument. If the argument retrieval fails, STATUS is a positive - number; if VALUE contains a truncated command line argument, - STATUS is -1; and otherwise the STATUS is zero. + argument. If the argument retrieval fails, STATUS is a positive + number; if VALUE contains a truncated command line argument, STATUS + is -1; and otherwise the STATUS is zero. _Example_: PROGRAM test_get_command_argument @@ -11093,7 +12271,7 @@ _See also_: File: gfortran.info, Node: GETCWD, Next: GETENV, Prev: GET_COMMAND_ARGUMENT, Up: Intrinsic Procedures -9.116 `GETCWD' -- Get current working directory +9.123 'GETCWD' -- Get current working directory =============================================== _Description_: @@ -11109,15 +12287,15 @@ _Class_: Subroutine, function _Syntax_: - `CALL GETCWD(C [, STATUS])' - `STATUS = GETCWD(C)' + 'CALL GETCWD(C [, STATUS])' + 'STATUS = GETCWD(C)' _Arguments_: - C The type shall be `CHARACTER' and of default - kind. - STATUS (Optional) status flag. Returns 0 on success, - a system specific and nonzero error code - otherwise. + C The type shall be 'CHARACTER' and of default + kind. + STATUS (Optional) status flag. Returns 0 on success, a + system specific and nonzero error code + otherwise. _Example_: PROGRAM test_getcwd @@ -11132,7 +12310,7 @@ _See also_: File: gfortran.info, Node: GETENV, Next: GET_ENVIRONMENT_VARIABLE, Prev: GETCWD, Up: Intrinsic Procedures -9.117 `GETENV' -- Get an environmental variable +9.124 'GETENV' -- Get an environmental variable =============================================== _Description_: @@ -11143,9 +12321,9 @@ _Description_: of the *note GET_ENVIRONMENT_VARIABLE:: intrinsic defined by the Fortran 2003 standard. - Note that `GETENV' need not be thread-safe. It is the + Note that 'GETENV' need not be thread-safe. It is the responsibility of the user to ensure that the environment is not - being updated concurrently with a call to the `GETENV' intrinsic. + being updated concurrently with a call to the 'GETENV' intrinsic. _Standard_: GNU extension @@ -11154,17 +12332,17 @@ _Class_: Subroutine _Syntax_: - `CALL GETENV(NAME, VALUE)' + 'CALL GETENV(NAME, VALUE)' _Arguments_: - NAME Shall be of type `CHARACTER' and of default - kind. - VALUE Shall be of type `CHARACTER' and of default - kind. + NAME Shall be of type 'CHARACTER' and of default + kind. + VALUE Shall be of type 'CHARACTER' and of default + kind. _Return value_: - Stores the value of NAME in VALUE. If VALUE is not large enough to - hold the data, it is truncated. If NAME is not set, VALUE will be + Stores the value of NAME in VALUE. If VALUE is not large enough to + hold the data, it is truncated. If NAME is not set, VALUE will be filled with blanks. _Example_: @@ -11180,16 +12358,16 @@ _See also_: File: gfortran.info, Node: GET_ENVIRONMENT_VARIABLE, Next: GETGID, Prev: GETENV, Up: Intrinsic Procedures -9.118 `GET_ENVIRONMENT_VARIABLE' -- Get an environmental variable +9.125 'GET_ENVIRONMENT_VARIABLE' -- Get an environmental variable ================================================================= _Description_: Get the VALUE of the environmental variable NAME. - Note that `GET_ENVIRONMENT_VARIABLE' need not be thread-safe. It + Note that 'GET_ENVIRONMENT_VARIABLE' need not be thread-safe. It is the responsibility of the user to ensure that the environment is not being updated concurrently with a call to the - `GET_ENVIRONMENT_VARIABLE' intrinsic. + 'GET_ENVIRONMENT_VARIABLE' intrinsic. _Standard_: Fortran 2003 and later @@ -11198,33 +12376,32 @@ _Class_: Subroutine _Syntax_: - `CALL GET_ENVIRONMENT_VARIABLE(NAME[, VALUE, LENGTH, STATUS, + 'CALL GET_ENVIRONMENT_VARIABLE(NAME[, VALUE, LENGTH, STATUS, TRIM_NAME)' _Arguments_: - NAME Shall be a scalar of type `CHARACTER' and of - default kind. - VALUE (Optional) Shall be a scalar of type - `CHARACTER' and of default kind. - LENGTH (Optional) Shall be a scalar of type `INTEGER' - and of default kind. - STATUS (Optional) Shall be a scalar of type `INTEGER' - and of default kind. - TRIM_NAME (Optional) Shall be a scalar of type `LOGICAL' - and of default kind. + NAME Shall be a scalar of type 'CHARACTER' and of + default kind. + VALUE (Optional) Shall be a scalar of type 'CHARACTER' + and of default kind. + LENGTH (Optional) Shall be a scalar of type 'INTEGER' + and of default kind. + STATUS (Optional) Shall be a scalar of type 'INTEGER' + and of default kind. + TRIM_NAME (Optional) Shall be a scalar of type 'LOGICAL' + and of default kind. _Return value_: - Stores the value of NAME in VALUE. If VALUE is not large enough to - hold the data, it is truncated. If NAME is not set, VALUE will be - filled with blanks. Argument LENGTH contains the length needed for - storing the environment variable NAME or zero if it is not - present. STATUS is -1 if VALUE is present but too short for the - environment variable; it is 1 if the environment variable does not - exist and 2 if the processor does not support environment - variables; in all other cases STATUS is zero. If TRIM_NAME is - present with the value `.FALSE.', the trailing blanks in NAME are - significant; otherwise they are not part of the environment - variable name. + Stores the value of NAME in VALUE. If VALUE is not large enough to + hold the data, it is truncated. If NAME is not set, VALUE will be + filled with blanks. Argument LENGTH contains the length needed for + storing the environment variable NAME or zero if it is not present. + STATUS is -1 if VALUE is present but too short for the environment + variable; it is 1 if the environment variable does not exist and 2 + if the processor does not support environment variables; in all + other cases STATUS is zero. If TRIM_NAME is present with the value + '.FALSE.', the trailing blanks in NAME are significant; otherwise + they are not part of the environment variable name. _Example_: PROGRAM test_getenv @@ -11236,7 +12413,7 @@ _Example_: File: gfortran.info, Node: GETGID, Next: GETLOG, Prev: GET_ENVIRONMENT_VARIABLE, Up: Intrinsic Procedures -9.119 `GETGID' -- Group ID function +9.126 'GETGID' -- Group ID function =================================== _Description_: @@ -11249,13 +12426,13 @@ _Class_: Function _Syntax_: - `RESULT = GETGID()' + 'RESULT = GETGID()' _Return value_: - The return value of `GETGID' is an `INTEGER' of the default kind. + The return value of 'GETGID' is an 'INTEGER' of the default kind. _Example_: - See `GETPID' for an example. + See 'GETPID' for an example. _See also_: *note GETPID::, *note GETUID:: @@ -11263,7 +12440,7 @@ _See also_: File: gfortran.info, Node: GETLOG, Next: GETPID, Prev: GETGID, Up: Intrinsic Procedures -9.120 `GETLOG' -- Get login name +9.127 'GETLOG' -- Get login name ================================ _Description_: @@ -11276,16 +12453,16 @@ _Class_: Subroutine _Syntax_: - `CALL GETLOG(C)' + 'CALL GETLOG(C)' _Arguments_: - C Shall be of type `CHARACTER' and of default - kind. + C Shall be of type 'CHARACTER' and of default + kind. _Return value_: Stores the current user name in LOGIN. (On systems where POSIX - functions `geteuid' and `getpwuid' are not available, and the - `getlogin' function is not implemented either, this will return a + functions 'geteuid' and 'getpwuid' are not available, and the + 'getlogin' function is not implemented either, this will return a blank string.) _Example_: @@ -11301,7 +12478,7 @@ _See also_: File: gfortran.info, Node: GETPID, Next: GETUID, Prev: GETLOG, Up: Intrinsic Procedures -9.121 `GETPID' -- Process ID function +9.128 'GETPID' -- Process ID function ===================================== _Description_: @@ -11314,10 +12491,10 @@ _Class_: Function _Syntax_: - `RESULT = GETPID()' + 'RESULT = GETPID()' _Return value_: - The return value of `GETPID' is an `INTEGER' of the default kind. + The return value of 'GETPID' is an 'INTEGER' of the default kind. _Example_: program info @@ -11332,7 +12509,7 @@ _See also_: File: gfortran.info, Node: GETUID, Next: GMTIME, Prev: GETPID, Up: Intrinsic Procedures -9.122 `GETUID' -- User ID function +9.129 'GETUID' -- User ID function ================================== _Description_: @@ -11345,13 +12522,13 @@ _Class_: Function _Syntax_: - `RESULT = GETUID()' + 'RESULT = GETUID()' _Return value_: - The return value of `GETUID' is an `INTEGER' of the default kind. + The return value of 'GETUID' is an 'INTEGER' of the default kind. _Example_: - See `GETPID' for an example. + See 'GETPID' for an example. _See also_: *note GETPID::, *note GETLOG:: @@ -11359,14 +12536,19 @@ _See also_: File: gfortran.info, Node: GMTIME, Next: HOSTNM, Prev: GETUID, Up: Intrinsic Procedures -9.123 `GMTIME' -- Convert time to GMT info +9.130 'GMTIME' -- Convert time to GMT info ========================================== _Description_: - Given a system time value TIME (as provided by the `TIME8' + Given a system time value TIME (as provided by the *note TIME:: intrinsic), fills VALUES with values extracted from it appropriate to the UTC time zone (Universal Coordinated Time, also known in - some countries as GMT, Greenwich Mean Time), using `gmtime(3)'. + some countries as GMT, Greenwich Mean Time), using 'gmtime(3)'. + + This intrinsic routine is provided for backwards compatibility with + GNU Fortran 77. In new code, programmers should consider the use + of the *note DATE_AND_TIME:: intrinsic defined by the Fortran 95 + standard. _Standard_: GNU extension @@ -11375,45 +12557,37 @@ _Class_: Subroutine _Syntax_: - `CALL GMTIME(TIME, VALUES)' + 'CALL GMTIME(TIME, VALUES)' _Arguments_: - TIME An `INTEGER' scalar expression corresponding - to a system time, with `INTENT(IN)'. - VALUES A default `INTEGER' array with 9 elements, - with `INTENT(OUT)'. + TIME An 'INTEGER' scalar expression corresponding to + a system time, with 'INTENT(IN)'. + VALUES A default 'INTEGER' array with 9 elements, with + 'INTENT(OUT)'. _Return value_: The elements of VALUES are assigned as follows: 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds - 2. Minutes after the hour, range 0-59 - 3. Hours past midnight, range 0-23 - - 4. Day of month, range 0-31 - - 5. Number of months since January, range 0-12 - + 4. Day of month, range 1-31 + 5. Number of months since January, range 0-11 6. Years since 1900 - 7. Number of days since Sunday, range 0-6 - - 8. Days since January 1 - + 8. Days since January 1, range 0-365 9. Daylight savings indicator: positive if daylight savings is in effect, zero if not, and negative if the information is not available. _See also_: - *note CTIME::, *note LTIME::, *note TIME::, *note TIME8:: - + *note DATE_AND_TIME::, *note CTIME::, *note LTIME::, *note TIME::, + *note TIME8:: File: gfortran.info, Node: HOSTNM, Next: HUGE, Prev: GMTIME, Up: Intrinsic Procedures -9.124 `HOSTNM' -- Get system host name +9.131 'HOSTNM' -- Get system host name ====================================== _Description_: @@ -11430,29 +12604,28 @@ _Class_: Subroutine, function _Syntax_: - `CALL HOSTNM(C [, STATUS])' - `STATUS = HOSTNM(NAME)' + 'CALL HOSTNM(C [, STATUS])' + 'STATUS = HOSTNM(NAME)' _Arguments_: - C Shall of type `CHARACTER' and of default kind. - STATUS (Optional) status flag of type `INTEGER'. - Returns 0 on success, or a system specific - error code otherwise. + C Shall of type 'CHARACTER' and of default kind. + STATUS (Optional) status flag of type 'INTEGER'. + Returns 0 on success, or a system specific error + code otherwise. _Return value_: In either syntax, NAME is set to the current hostname if it can be obtained, or to a blank string otherwise. - File: gfortran.info, Node: HUGE, Next: HYPOT, Prev: HOSTNM, Up: Intrinsic Procedures -9.125 `HUGE' -- Largest number of a kind +9.132 'HUGE' -- Largest number of a kind ======================================== _Description_: - `HUGE(X)' returns the largest number that is not an infinity in - the model of the type of `X'. + 'HUGE(X)' returns the largest number that is not an infinity in the + model of the type of 'X'. _Standard_: Fortran 95 and later @@ -11461,10 +12634,10 @@ _Class_: Inquiry function _Syntax_: - `RESULT = HUGE(X)' + 'RESULT = HUGE(X)' _Arguments_: - X Shall be of type `REAL' or `INTEGER'. + X Shall be of type 'REAL' or 'INTEGER'. _Return value_: The return value is of the same type and kind as X @@ -11478,12 +12651,12 @@ _Example_: File: gfortran.info, Node: HYPOT, Next: IACHAR, Prev: HUGE, Up: Intrinsic Procedures -9.126 `HYPOT' -- Euclidean distance function +9.133 'HYPOT' -- Euclidean distance function ============================================ _Description_: - `HYPOT(X,Y)' is the Euclidean distance function. It is equal to - \sqrtX^2 + Y^2, without undue underflow or overflow. + 'HYPOT(X,Y)' is the Euclidean distance function. It is equal to + \sqrt{X^2 + Y^2}, without undue underflow or overflow. _Standard_: Fortran 2008 and later @@ -11492,12 +12665,12 @@ _Class_: Elemental function _Syntax_: - `RESULT = HYPOT(X, Y)' + 'RESULT = HYPOT(X, Y)' _Arguments_: - X The type shall be `REAL'. - Y The type and kind type parameter shall be the - same as X. + X The type shall be 'REAL'. + Y The type and kind type parameter shall be the + same as X. _Return value_: The return value has the same type and kind type parameter as X. @@ -11511,12 +12684,12 @@ _Example_: File: gfortran.info, Node: IACHAR, Next: IALL, Prev: HYPOT, Up: Intrinsic Procedures -9.127 `IACHAR' -- Code in ASCII collating sequence +9.134 'IACHAR' -- Code in ASCII collating sequence ================================================== _Description_: - `IACHAR(C)' returns the code for the ASCII character in the first - character position of `C'. + 'IACHAR(C)' returns the code for the ASCII character in the first + character position of 'C'. _Standard_: Fortran 95 and later, with KIND argument Fortran 2003 and later @@ -11525,17 +12698,16 @@ _Class_: Elemental function _Syntax_: - `RESULT = IACHAR(C [, KIND])' + 'RESULT = IACHAR(C [, KIND])' _Arguments_: - C Shall be a scalar `CHARACTER', with - `INTENT(IN)' - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + C Shall be a scalar 'CHARACTER', with 'INTENT(IN)' + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. _Example_: @@ -11551,16 +12723,15 @@ _Note_: _See also_: *note ACHAR::, *note CHAR::, *note ICHAR:: - File: gfortran.info, Node: IALL, Next: IAND, Prev: IACHAR, Up: Intrinsic Procedures -9.128 `IALL' -- Bitwise AND of array elements +9.135 'IALL' -- Bitwise AND of array elements ============================================= _Description_: Reduces with bitwise AND the elements of ARRAY along dimension DIM - if the corresponding element in MASK is `TRUE'. + if the corresponding element in MASK is 'TRUE'. _Standard_: Fortran 2008 and later @@ -11569,23 +12740,23 @@ _Class_: Transformational function _Syntax_: - `RESULT = IALL(ARRAY[, MASK])' - `RESULT = IALL(ARRAY, DIM[, MASK])' + 'RESULT = IALL(ARRAY[, MASK])' + 'RESULT = IALL(ARRAY, DIM[, MASK])' _Arguments_: - ARRAY Shall be an array of type `INTEGER' - DIM (Optional) shall be a scalar of type `INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type `LOGICAL' and - either be a scalar or an array of the same - shape as ARRAY. + ARRAY Shall be an array of type 'INTEGER' + DIM (Optional) shall be a scalar of type 'INTEGER' + with a value in the range from 1 to n, where n + equals the rank of ARRAY. + MASK (Optional) shall be of type 'LOGICAL' and either + be a scalar or an array of the same shape as + ARRAY. _Return value_: The result is of the same type as ARRAY. If DIM is absent, a scalar with the bitwise ALL of all elements in - ARRAY is returned. Otherwise, an array of rank n-1, where n equals + ARRAY is returned. Otherwise, an array of rank n-1, where n equals the rank of ARRAY, and a shape similar to that of ARRAY with dimension DIM dropped is returned. @@ -11606,31 +12777,31 @@ _See also_: File: gfortran.info, Node: IAND, Next: IANY, Prev: IALL, Up: Intrinsic Procedures -9.129 `IAND' -- Bitwise logical and +9.136 'IAND' -- Bitwise logical and =================================== _Description_: - Bitwise logical `AND'. + Bitwise logical 'AND'. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = IAND(I, J)' + 'RESULT = IAND(I, J)' _Arguments_: - I The type shall be `INTEGER'. - J The type shall be `INTEGER', of the same kind - as I. (As a GNU extension, different kinds - are also permitted.) + I The type shall be 'INTEGER'. + J The type shall be 'INTEGER', of the same kind as + I. (As a GNU extension, different kinds are + also permitted.) _Return value_: - The return type is `INTEGER', of the same kind as the arguments. - (If the argument kinds differ, it is of the same kind as the - larger argument.) + The return type is 'INTEGER', of the same kind as the arguments. + (If the argument kinds differ, it is of the same kind as the larger + argument.) _Example_: PROGRAM test_iand @@ -11639,20 +12810,32 @@ _Example_: WRITE (*,*) IAND(a, b) END PROGRAM +_Specific names_: + Name Argument Return type Standard + 'IAND(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BIAND(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IIAND(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JIAND(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KIAND(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' + _See also_: *note IOR::, *note IEOR::, *note IBITS::, *note IBSET::, *note IBCLR::, *note NOT:: - File: gfortran.info, Node: IANY, Next: IARGC, Prev: IAND, Up: Intrinsic Procedures -9.130 `IANY' -- Bitwise OR of array elements +9.137 'IANY' -- Bitwise OR of array elements ============================================ _Description_: Reduces with bitwise OR (inclusive or) the elements of ARRAY along - dimension DIM if the corresponding element in MASK is `TRUE'. + dimension DIM if the corresponding element in MASK is 'TRUE'. _Standard_: Fortran 2008 and later @@ -11661,23 +12844,23 @@ _Class_: Transformational function _Syntax_: - `RESULT = IANY(ARRAY[, MASK])' - `RESULT = IANY(ARRAY, DIM[, MASK])' + 'RESULT = IANY(ARRAY[, MASK])' + 'RESULT = IANY(ARRAY, DIM[, MASK])' _Arguments_: - ARRAY Shall be an array of type `INTEGER' - DIM (Optional) shall be a scalar of type `INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type `LOGICAL' and - either be a scalar or an array of the same - shape as ARRAY. + ARRAY Shall be an array of type 'INTEGER' + DIM (Optional) shall be a scalar of type 'INTEGER' + with a value in the range from 1 to n, where n + equals the rank of ARRAY. + MASK (Optional) shall be of type 'LOGICAL' and either + be a scalar or an array of the same shape as + ARRAY. _Return value_: The result is of the same type as ARRAY. If DIM is absent, a scalar with the bitwise OR of all elements in - ARRAY is returned. Otherwise, an array of rank n-1, where n equals + ARRAY is returned. Otherwise, an array of rank n-1, where n equals the rank of ARRAY, and a shape similar to that of ARRAY with dimension DIM dropped is returned. @@ -11698,11 +12881,11 @@ _See also_: File: gfortran.info, Node: IARGC, Next: IBCLR, Prev: IANY, Up: Intrinsic Procedures -9.131 `IARGC' -- Get the number of command line arguments +9.138 'IARGC' -- Get the number of command line arguments ========================================================= _Description_: - `IARGC' returns the number of arguments passed on the command line + 'IARGC' returns the number of arguments passed on the command line when the containing program was invoked. This intrinsic routine is provided for backwards compatibility with @@ -11717,13 +12900,13 @@ _Class_: Function _Syntax_: - `RESULT = IARGC()' + 'RESULT = IARGC()' _Arguments_: None. _Return value_: - The number of command line arguments, type `INTEGER(4)'. + The number of command line arguments, type 'INTEGER(4)'. _Example_: See *note GETARG:: @@ -11737,107 +12920,144 @@ _See also_: File: gfortran.info, Node: IBCLR, Next: IBITS, Prev: IARGC, Up: Intrinsic Procedures -9.132 `IBCLR' -- Clear bit +9.139 'IBCLR' -- Clear bit ========================== _Description_: - `IBCLR' returns the value of I with the bit at position POS set to + 'IBCLR' returns the value of I with the bit at position POS set to zero. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = IBCLR(I, POS)' + 'RESULT = IBCLR(I, POS)' _Arguments_: - I The type shall be `INTEGER'. - POS The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + POS The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. + +_Specific names_: + Name Argument Return type Standard + 'IBCLR(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BBCLR(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IIBCLR(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JIBCLR(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KIBCLR(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' _See also_: *note IBITS::, *note IBSET::, *note IAND::, *note IOR::, *note IEOR::, *note MVBITS:: - File: gfortran.info, Node: IBITS, Next: IBSET, Prev: IBCLR, Up: Intrinsic Procedures -9.133 `IBITS' -- Bit extraction +9.140 'IBITS' -- Bit extraction =============================== _Description_: - `IBITS' extracts a field of length LEN from I, starting from bit + 'IBITS' extracts a field of length LEN from I, starting from bit position POS and extending left for LEN bits. The result is right-justified and the remaining bits are zeroed. The value of - `POS+LEN' must be less than or equal to the value `BIT_SIZE(I)'. + 'POS+LEN' must be less than or equal to the value 'BIT_SIZE(I)'. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = IBITS(I, POS, LEN)' + 'RESULT = IBITS(I, POS, LEN)' _Arguments_: - I The type shall be `INTEGER'. - POS The type shall be `INTEGER'. - LEN The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + POS The type shall be 'INTEGER'. + LEN The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. + +_Specific names_: + Name Argument Return type Standard + 'IBITS(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BBITS(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IIBITS(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JIBITS(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KIBITS(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' _See also_: - *note BIT_SIZE::, *note IBCLR::, *note IBSET::, *note IAND::, - *note IOR::, *note IEOR:: + *note BIT_SIZE::, *note IBCLR::, *note IBSET::, *note IAND::, *note + IOR::, *note IEOR:: File: gfortran.info, Node: IBSET, Next: ICHAR, Prev: IBITS, Up: Intrinsic Procedures -9.134 `IBSET' -- Set bit +9.141 'IBSET' -- Set bit ======================== _Description_: - `IBSET' returns the value of I with the bit at position POS set to + 'IBSET' returns the value of I with the bit at position POS set to one. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = IBSET(I, POS)' + 'RESULT = IBSET(I, POS)' _Arguments_: - I The type shall be `INTEGER'. - POS The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + POS The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. + +_Specific names_: + Name Argument Return type Standard + 'IBSET(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BBSET(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IIBSET(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JIBSET(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KIBSET(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' _See also_: *note IBCLR::, *note IBITS::, *note IAND::, *note IOR::, *note IEOR::, *note MVBITS:: - File: gfortran.info, Node: ICHAR, Next: IDATE, Prev: IBSET, Up: Intrinsic Procedures -9.135 `ICHAR' -- Character-to-integer conversion function +9.142 'ICHAR' -- Character-to-integer conversion function ========================================================= _Description_: - `ICHAR(C)' returns the code for the character in the first - character position of `C' in the system's native character set. + 'ICHAR(C)' returns the code for the character in the first + character position of 'C' in the system's native character set. The correspondence between characters and their codes is not necessarily the same across different GNU Fortran implementations. @@ -11848,17 +13068,16 @@ _Class_: Elemental function _Syntax_: - `RESULT = ICHAR(C [, KIND])' + 'RESULT = ICHAR(C [, KIND])' _Arguments_: - C Shall be a scalar `CHARACTER', with - `INTENT(IN)' - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + C Shall be a scalar 'CHARACTER', with 'INTENT(IN)' + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. _Example_: @@ -11868,15 +13087,15 @@ _Example_: end program test_ichar _Specific names_: - Name Argument Return type Standard - `ICHAR(C)' `CHARACTER `INTEGER(4)' Fortran 77 and - C' later + Name Argument Return type Standard + 'ICHAR(C)' 'CHARACTER 'INTEGER(4)' Fortran 77 and + C' later _Note_: No intrinsic exists to convert between a numeric value and a formatted character string representation - for instance, given the - `CHARACTER' value `'154'', obtaining an `INTEGER' or `REAL' value - with the value 154, or vice versa. Instead, this functionality is + 'CHARACTER' value ''154'', obtaining an 'INTEGER' or 'REAL' value + with the value 154, or vice versa. Instead, this functionality is provided by internal-file I/O, as in the following example: program read_val integer value @@ -11895,19 +13114,23 @@ _Note_: _See also_: *note ACHAR::, *note CHAR::, *note IACHAR:: - File: gfortran.info, Node: IDATE, Next: IEOR, Prev: ICHAR, Up: Intrinsic Procedures -9.136 `IDATE' -- Get current local time subroutine (day/month/year) +9.143 'IDATE' -- Get current local time subroutine (day/month/year) =================================================================== _Description_: - `IDATE(VALUES)' Fills VALUES with the numerical values at the - current local time. The day (in the range 1-31), month (in the + 'IDATE(VALUES)' Fills VALUES with the numerical values at the + current local time. The day (in the range 1-31), month (in the range 1-12), and year appear in elements 1, 2, and 3 of VALUES, respectively. The year has four significant digits. + This intrinsic routine is provided for backwards compatibility with + GNU Fortran 77. In new code, programmers should consider the use + of the *note DATE_AND_TIME:: intrinsic defined by the Fortran 95 + standard. + _Standard_: GNU extension @@ -11915,11 +13138,11 @@ _Class_: Subroutine _Syntax_: - `CALL IDATE(VALUES)' + 'CALL IDATE(VALUES)' _Arguments_: - VALUES The type shall be `INTEGER, DIMENSION(3)' and - the kind shall be the default integer kind. + VALUES The type shall be 'INTEGER, DIMENSION(3)' and + the kind shall be the default integer kind. _Return value_: Does not return anything. @@ -11933,34 +13156,50 @@ _Example_: print *, tarray(3) end program test_idate +_See also_: + *note DATE_AND_TIME:: + File: gfortran.info, Node: IEOR, Next: IERRNO, Prev: IDATE, Up: Intrinsic Procedures -9.137 `IEOR' -- Bitwise logical exclusive or +9.144 'IEOR' -- Bitwise logical exclusive or ============================================ _Description_: - `IEOR' returns the bitwise Boolean exclusive-OR of I and J. + 'IEOR' returns the bitwise Boolean exclusive-OR of I and J. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = IEOR(I, J)' + 'RESULT = IEOR(I, J)' _Arguments_: - I The type shall be `INTEGER'. - J The type shall be `INTEGER', of the same kind - as I. (As a GNU extension, different kinds - are also permitted.) + I The type shall be 'INTEGER'. + J The type shall be 'INTEGER', of the same kind as + I. (As a GNU extension, different kinds are + also permitted.) _Return value_: - The return type is `INTEGER', of the same kind as the arguments. - (If the argument kinds differ, it is of the same kind as the - larger argument.) + The return type is 'INTEGER', of the same kind as the arguments. + (If the argument kinds differ, it is of the same kind as the larger + argument.) + +_Specific names_: + Name Argument Return type Standard + 'IEOR(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BIEOR(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IIEOR(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JIEOR(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KIEOR(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' _See also_: *note IOR::, *note IAND::, *note IBITS::, *note IBSET::, *note @@ -11969,11 +13208,11 @@ _See also_: File: gfortran.info, Node: IERRNO, Next: IMAGE_INDEX, Prev: IEOR, Up: Intrinsic Procedures -9.138 `IERRNO' -- Get the last system error number +9.145 'IERRNO' -- Get the last system error number ================================================== _Description_: - Returns the last system error number, as given by the C `errno' + Returns the last system error number, as given by the C 'errno' variable. _Standard_: @@ -11983,13 +13222,13 @@ _Class_: Function _Syntax_: - `RESULT = IERRNO()' + 'RESULT = IERRNO()' _Arguments_: None. _Return value_: - The return value is of type `INTEGER' and of the default integer + The return value is of type 'INTEGER' and of the default integer kind. _See also_: @@ -11998,7 +13237,7 @@ _See also_: File: gfortran.info, Node: IMAGE_INDEX, Next: INDEX intrinsic, Prev: IERRNO, Up: Intrinsic Procedures -9.139 `IMAGE_INDEX' -- Function that converts a cosubscript to an image index +9.146 'IMAGE_INDEX' -- Function that converts a cosubscript to an image index ============================================================================= _Description_: @@ -12011,16 +13250,16 @@ _Class_: Inquiry function. _Syntax_: - `RESULT = IMAGE_INDEX(COARRAY, SUB)' + 'RESULT = IMAGE_INDEX(COARRAY, SUB)' _Arguments_: None. - COARRAY Coarray of any type. - SUB default integer rank-1 array of a size equal to - the corank of COARRAY. + COARRAY Coarray of any type. + SUB default integer rank-1 array of a size equal to + the corank of COARRAY. _Return value_: Scalar default integer with the value of the image index which - corresponds to the cosubscripts. For invalid cosubscripts the + corresponds to the cosubscripts. For invalid cosubscripts the result is zero. _Example_: @@ -12034,7 +13273,7 @@ _See also_: File: gfortran.info, Node: INDEX intrinsic, Next: INT, Prev: IMAGE_INDEX, Up: Intrinsic Procedures -9.140 `INDEX' -- Position of a substring within a string +9.147 'INDEX' -- Position of a substring within a string ======================================================== _Description_: @@ -12051,27 +13290,25 @@ _Class_: Elemental function _Syntax_: - `RESULT = INDEX(STRING, SUBSTRING [, BACK [, KIND]])' + 'RESULT = INDEX(STRING, SUBSTRING [, BACK [, KIND]])' _Arguments_: - STRING Shall be a scalar `CHARACTER', with - `INTENT(IN)' - SUBSTRING Shall be a scalar `CHARACTER', with - `INTENT(IN)' - BACK (Optional) Shall be a scalar `LOGICAL', with - `INTENT(IN)' - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + STRING Shall be a scalar 'CHARACTER', with 'INTENT(IN)' + SUBSTRING Shall be a scalar 'CHARACTER', with 'INTENT(IN)' + BACK (Optional) Shall be a scalar 'LOGICAL', with + 'INTENT(IN)' + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. _Specific names_: - Name Argument Return type Standard - `INDEX(STRING,`CHARACTER' `INTEGER(4)' Fortran 77 and - SUBSTRING)' later + Name Argument Return type Standard + 'INDEX(STRING, 'CHARACTER' 'INTEGER(4)' Fortran 77 and + SUBSTRING)' later _See also_: *note SCAN::, *note VERIFY:: @@ -12079,7 +13316,7 @@ _See also_: File: gfortran.info, Node: INT, Next: INT2, Prev: INDEX intrinsic, Up: Intrinsic Procedures -9.141 `INT' -- Convert to integer type +9.148 'INT' -- Convert to integer type ====================================== _Description_: @@ -12092,30 +13329,28 @@ _Class_: Elemental function _Syntax_: - `RESULT = INT(A [, KIND))' + 'RESULT = INT(A [, KIND))' _Arguments_: - A Shall be of type `INTEGER', `REAL', or - `COMPLEX'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + A Shall be of type 'INTEGER', 'REAL', or + 'COMPLEX'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - These functions return a `INTEGER' variable or array under the + These functions return a 'INTEGER' variable or array under the following rules: - (A) - If A is of type `INTEGER', `INT(A) = A' - - (B) - If A is of type `REAL' and |A| < 1, `INT(A)' equals `0'. If - |A| \geq 1, then `INT(A)' is the integer whose magnitude is + (A) + If A is of type 'INTEGER', 'INT(A) = A' + (B) + If A is of type 'REAL' and |A| < 1, 'INT(A)' equals '0'. If + |A| \geq 1, then 'INT(A)' is the integer whose magnitude is the largest integer that does not exceed the magnitude of A and whose sign is the same as the sign of A. - - (C) - If A is of type `COMPLEX', rule B is applied to the real part + (C) + If A is of type 'COMPLEX', rule B is applied to the real part of A. _Example_: @@ -12127,27 +13362,26 @@ _Example_: end program _Specific names_: - Name Argument Return type Standard - `INT(A)' `REAL(4) A' `INTEGER' Fortran 77 and - later - `IFIX(A)' `REAL(4) A' `INTEGER' Fortran 77 and - later - `IDINT(A)' `REAL(8) A' `INTEGER' Fortran 77 and - later - + Name Argument Return type Standard + 'INT(A)' 'REAL(4) A' 'INTEGER' Fortran 77 and + later + 'IFIX(A)' 'REAL(4) A' 'INTEGER' Fortran 77 and + later + 'IDINT(A)' 'REAL(8) A' 'INTEGER' Fortran 77 and + later File: gfortran.info, Node: INT2, Next: INT8, Prev: INT, Up: Intrinsic Procedures -9.142 `INT2' -- Convert to 16-bit integer type +9.149 'INT2' -- Convert to 16-bit integer type ============================================== _Description_: - Convert to a `KIND=2' integer type. This is equivalent to the - standard `INT' intrinsic with an optional argument of `KIND=2', - and is only included for backwards compatibility. + Convert to a 'KIND=2' integer type. This is equivalent to the + standard 'INT' intrinsic with an optional argument of 'KIND=2', and + is only included for backwards compatibility. - The `SHORT' intrinsic is equivalent to `INT2'. + The 'SHORT' intrinsic is equivalent to 'INT2'. _Standard_: GNU extension @@ -12156,14 +13390,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = INT2(A)' + 'RESULT = INT2(A)' _Arguments_: - A Shall be of type `INTEGER', `REAL', or - `COMPLEX'. + A Shall be of type 'INTEGER', 'REAL', or + 'COMPLEX'. _Return value_: - The return value is a `INTEGER(2)' variable. + The return value is a 'INTEGER(2)' variable. _See also_: *note INT::, *note INT8::, *note LONG:: @@ -12171,13 +13405,13 @@ _See also_: File: gfortran.info, Node: INT8, Next: IOR, Prev: INT2, Up: Intrinsic Procedures -9.143 `INT8' -- Convert to 64-bit integer type +9.150 'INT8' -- Convert to 64-bit integer type ============================================== _Description_: - Convert to a `KIND=8' integer type. This is equivalent to the - standard `INT' intrinsic with an optional argument of `KIND=8', - and is only included for backwards compatibility. + Convert to a 'KIND=8' integer type. This is equivalent to the + standard 'INT' intrinsic with an optional argument of 'KIND=8', and + is only included for backwards compatibility. _Standard_: GNU extension @@ -12186,14 +13420,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = INT8(A)' + 'RESULT = INT8(A)' _Arguments_: - A Shall be of type `INTEGER', `REAL', or - `COMPLEX'. + A Shall be of type 'INTEGER', 'REAL', or + 'COMPLEX'. _Return value_: - The return value is a `INTEGER(8)' variable. + The return value is a 'INTEGER(8)' variable. _See also_: *note INT::, *note INT2::, *note LONG:: @@ -12201,31 +13435,44 @@ _See also_: File: gfortran.info, Node: IOR, Next: IPARITY, Prev: INT8, Up: Intrinsic Procedures -9.144 `IOR' -- Bitwise logical or +9.151 'IOR' -- Bitwise logical or ================================= _Description_: - `IOR' returns the bitwise Boolean inclusive-OR of I and J. + 'IOR' returns the bitwise Boolean inclusive-OR of I and J. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = IOR(I, J)' + 'RESULT = IOR(I, J)' _Arguments_: - I The type shall be `INTEGER'. - J The type shall be `INTEGER', of the same kind - as I. (As a GNU extension, different kinds - are also permitted.) + I The type shall be 'INTEGER'. + J The type shall be 'INTEGER', of the same kind as + I. (As a GNU extension, different kinds are + also permitted.) _Return value_: - The return type is `INTEGER', of the same kind as the arguments. - (If the argument kinds differ, it is of the same kind as the - larger argument.) + The return type is 'INTEGER', of the same kind as the arguments. + (If the argument kinds differ, it is of the same kind as the larger + argument.) + +_Specific names_: + Name Argument Return type Standard + 'IOR(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BIOR(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IIOR(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JIOR(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KIOR(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' _See also_: *note IEOR::, *note IAND::, *note IBITS::, *note IBSET::, *note @@ -12234,12 +13481,12 @@ _See also_: File: gfortran.info, Node: IPARITY, Next: IRAND, Prev: IOR, Up: Intrinsic Procedures -9.145 `IPARITY' -- Bitwise XOR of array elements +9.152 'IPARITY' -- Bitwise XOR of array elements ================================================ _Description_: Reduces with bitwise XOR (exclusive or) the elements of ARRAY along - dimension DIM if the corresponding element in MASK is `TRUE'. + dimension DIM if the corresponding element in MASK is 'TRUE'. _Standard_: Fortran 2008 and later @@ -12248,23 +13495,23 @@ _Class_: Transformational function _Syntax_: - `RESULT = IPARITY(ARRAY[, MASK])' - `RESULT = IPARITY(ARRAY, DIM[, MASK])' + 'RESULT = IPARITY(ARRAY[, MASK])' + 'RESULT = IPARITY(ARRAY, DIM[, MASK])' _Arguments_: - ARRAY Shall be an array of type `INTEGER' - DIM (Optional) shall be a scalar of type `INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type `LOGICAL' and - either be a scalar or an array of the same - shape as ARRAY. + ARRAY Shall be an array of type 'INTEGER' + DIM (Optional) shall be a scalar of type 'INTEGER' + with a value in the range from 1 to n, where n + equals the rank of ARRAY. + MASK (Optional) shall be of type 'LOGICAL' and either + be a scalar or an array of the same shape as + ARRAY. _Return value_: The result is of the same type as ARRAY. If DIM is absent, a scalar with the bitwise XOR of all elements in - ARRAY is returned. Otherwise, an array of rank n-1, where n equals + ARRAY is returned. Otherwise, an array of rank n-1, where n equals the rank of ARRAY, and a shape similar to that of ARRAY with dimension DIM dropped is returned. @@ -12285,21 +13532,21 @@ _See also_: File: gfortran.info, Node: IRAND, Next: IS_IOSTAT_END, Prev: IPARITY, Up: Intrinsic Procedures -9.146 `IRAND' -- Integer pseudo-random number +9.153 'IRAND' -- Integer pseudo-random number ============================================= _Description_: - `IRAND(FLAG)' returns a pseudo-random number from a uniform + 'IRAND(FLAG)' returns a pseudo-random number from a uniform distribution between 0 and a system-dependent limit (which is in - most cases 2147483647). If FLAG is 0, the next number in the + most cases 2147483647). If FLAG is 0, the next number in the current sequence is returned; if FLAG is 1, the generator is - restarted by `CALL SRAND(0)'; if FLAG has any other value, it is - used as a new seed with `SRAND'. + restarted by 'CALL SRAND(0)'; if FLAG has any other value, it is + used as a new seed with 'SRAND'. This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. It implements a simple modulo generator as provided - by `g77'. For new code, one should consider the use of *note - RANDOM_NUMBER:: as it implements a superior algorithm. + GNU Fortran 77. It implements a simple modulo generator as + provided by 'g77'. For new code, one should consider the use of + *note RANDOM_NUMBER:: as it implements a superior algorithm. _Standard_: GNU extension @@ -12308,13 +13555,13 @@ _Class_: Function _Syntax_: - `RESULT = IRAND(I)' + 'RESULT = IRAND(I)' _Arguments_: - I Shall be a scalar `INTEGER' of kind 4. + I Shall be a scalar 'INTEGER' of kind 4. _Return value_: - The return value is of `INTEGER(kind=4)' type. + The return value is of 'INTEGER(kind=4)' type. _Example_: program test_irand @@ -12325,18 +13572,17 @@ _Example_: print *, irand(seed), irand(), irand(), irand() end program test_irand - File: gfortran.info, Node: IS_IOSTAT_END, Next: IS_IOSTAT_EOR, Prev: IRAND, Up: Intrinsic Procedures -9.147 `IS_IOSTAT_END' -- Test for end-of-file value +9.154 'IS_IOSTAT_END' -- Test for end-of-file value =================================================== _Description_: - `IS_IOSTAT_END' tests whether an variable has the value of the I/O - status "end of file". The function is equivalent to comparing the - variable with the `IOSTAT_END' parameter of the intrinsic module - `ISO_FORTRAN_ENV'. + 'IS_IOSTAT_END' tests whether an variable has the value of the I/O + status "end of file". The function is equivalent to comparing the + variable with the 'IOSTAT_END' parameter of the intrinsic module + 'ISO_FORTRAN_ENV'. _Standard_: Fortran 2003 and later @@ -12345,15 +13591,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = IS_IOSTAT_END(I)' + 'RESULT = IS_IOSTAT_END(I)' _Arguments_: - I Shall be of the type `INTEGER'. + I Shall be of the type 'INTEGER'. _Return value_: - Returns a `LOGICAL' of the default kind, which `.TRUE.' if I has - the value which indicates an end of file condition for `IOSTAT=' - specifiers, and is `.FALSE.' otherwise. + Returns a 'LOGICAL' of the default kind, which '.TRUE.' if I has + the value which indicates an end of file condition for 'IOSTAT=' + specifiers, and is '.FALSE.' otherwise. _Example_: PROGRAM iostat @@ -12367,14 +13613,14 @@ _Example_: File: gfortran.info, Node: IS_IOSTAT_EOR, Next: ISATTY, Prev: IS_IOSTAT_END, Up: Intrinsic Procedures -9.148 `IS_IOSTAT_EOR' -- Test for end-of-record value +9.155 'IS_IOSTAT_EOR' -- Test for end-of-record value ===================================================== _Description_: - `IS_IOSTAT_EOR' tests whether an variable has the value of the I/O - status "end of record". The function is equivalent to comparing the - variable with the `IOSTAT_EOR' parameter of the intrinsic module - `ISO_FORTRAN_ENV'. + 'IS_IOSTAT_EOR' tests whether an variable has the value of the I/O + status "end of record". The function is equivalent to comparing + the variable with the 'IOSTAT_EOR' parameter of the intrinsic + module 'ISO_FORTRAN_ENV'. _Standard_: Fortran 2003 and later @@ -12383,15 +13629,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = IS_IOSTAT_EOR(I)' + 'RESULT = IS_IOSTAT_EOR(I)' _Arguments_: - I Shall be of the type `INTEGER'. + I Shall be of the type 'INTEGER'. _Return value_: - Returns a `LOGICAL' of the default kind, which `.TRUE.' if I has - the value which indicates an end of file condition for `IOSTAT=' - specifiers, and is `.FALSE.' otherwise. + Returns a 'LOGICAL' of the default kind, which '.TRUE.' if I has + the value which indicates an end of file condition for 'IOSTAT=' + specifiers, and is '.FALSE.' otherwise. _Example_: PROGRAM iostat @@ -12405,7 +13651,7 @@ _Example_: File: gfortran.info, Node: ISATTY, Next: ISHFT, Prev: IS_IOSTAT_EOR, Up: Intrinsic Procedures -9.149 `ISATTY' -- Whether a unit is a terminal device. +9.156 'ISATTY' -- Whether a unit is a terminal device. ====================================================== _Description_: @@ -12418,14 +13664,14 @@ _Class_: Function _Syntax_: - `RESULT = ISATTY(UNIT)' + 'RESULT = ISATTY(UNIT)' _Arguments_: - UNIT Shall be a scalar `INTEGER'. + UNIT Shall be a scalar 'INTEGER'. _Return value_: - Returns `.TRUE.' if the UNIT is connected to a terminal device, - `.FALSE.' otherwise. + Returns '.TRUE.' if the UNIT is connected to a terminal device, + '.FALSE.' otherwise. _Example_: PROGRAM test_isatty @@ -12434,40 +13680,52 @@ _Example_: write(*,*) isatty(unit=unit) END DO END PROGRAM - _See also_: *note TTYNAM:: File: gfortran.info, Node: ISHFT, Next: ISHFTC, Prev: ISATTY, Up: Intrinsic Procedures -9.150 `ISHFT' -- Shift bits +9.157 'ISHFT' -- Shift bits =========================== _Description_: - `ISHFT' returns a value corresponding to I with all of the bits + 'ISHFT' returns a value corresponding to I with all of the bits shifted SHIFT places. A value of SHIFT greater than zero corresponds to a left shift, a value of zero corresponds to no - shift, and a value less than zero corresponds to a right shift. - If the absolute value of SHIFT is greater than `BIT_SIZE(I)', the + shift, and a value less than zero corresponds to a right shift. If + the absolute value of SHIFT is greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted out from the left end or right end are lost; zeros are shifted in from the opposite end. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = ISHFT(I, SHIFT)' + 'RESULT = ISHFT(I, SHIFT)' _Arguments_: - I The type shall be `INTEGER'. - SHIFT The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + SHIFT The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. + +_Specific names_: + Name Argument Return type Standard + 'ISHFT(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BSHFT(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IISHFT(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JISHFT(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KISHFT(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' _See also_: *note ISHFTC:: @@ -12475,37 +13733,50 @@ _See also_: File: gfortran.info, Node: ISHFTC, Next: ISNAN, Prev: ISHFT, Up: Intrinsic Procedures -9.151 `ISHFTC' -- Shift bits circularly +9.158 'ISHFTC' -- Shift bits circularly ======================================= _Description_: - `ISHFTC' returns a value corresponding to I with the rightmost - SIZE bits shifted circularly SHIFT places; that is, bits shifted - out one end are shifted into the opposite end. A value of SHIFT - greater than zero corresponds to a left shift, a value of zero - corresponds to no shift, and a value less than zero corresponds to - a right shift. The absolute value of SHIFT must be less than - SIZE. If the SIZE argument is omitted, it is taken to be - equivalent to `BIT_SIZE(I)'. + 'ISHFTC' returns a value corresponding to I with the rightmost SIZE + bits shifted circularly SHIFT places; that is, bits shifted out one + end are shifted into the opposite end. A value of SHIFT greater + than zero corresponds to a left shift, a value of zero corresponds + to no shift, and a value less than zero corresponds to a right + shift. The absolute value of SHIFT must be less than SIZE. If the + SIZE argument is omitted, it is taken to be equivalent to + 'BIT_SIZE(I)'. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = ISHFTC(I, SHIFT [, SIZE])' + 'RESULT = ISHFTC(I, SHIFT [, SIZE])' _Arguments_: - I The type shall be `INTEGER'. - SHIFT The type shall be `INTEGER'. - SIZE (Optional) The type shall be `INTEGER'; the - value must be greater than zero and less than - or equal to `BIT_SIZE(I)'. + I The type shall be 'INTEGER'. + SHIFT The type shall be 'INTEGER'. + SIZE (Optional) The type shall be 'INTEGER'; the + value must be greater than zero and less than or + equal to 'BIT_SIZE(I)'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. + +_Specific names_: + Name Argument Return type Standard + 'ISHFTC(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BSHFTC(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IISHFTC(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JISHFTC(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KISHFTC(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' _See also_: *note ISHFT:: @@ -12513,13 +13784,12 @@ _See also_: File: gfortran.info, Node: ISNAN, Next: ITIME, Prev: ISHFTC, Up: Intrinsic Procedures -9.152 `ISNAN' -- Test for a NaN +9.159 'ISNAN' -- Test for a NaN =============================== _Description_: - `ISNAN' tests whether a floating-point value is an IEEE + 'ISNAN' tests whether a floating-point value is an IEEE Not-a-Number (NaN). - _Standard_: GNU extension @@ -12527,14 +13797,15 @@ _Class_: Elemental function _Syntax_: - `ISNAN(X)' + 'ISNAN(X)' _Arguments_: - X Variable of the type `REAL'. + X Variable of the type 'REAL'. + _Return value_: - Returns a default-kind `LOGICAL'. The returned value is `TRUE' if - X is a NaN and `FALSE' otherwise. + Returns a default-kind 'LOGICAL'. The returned value is 'TRUE' if + X is a NaN and 'FALSE' otherwise. _Example_: program test_nan @@ -12548,15 +13819,20 @@ _Example_: File: gfortran.info, Node: ITIME, Next: KILL, Prev: ISNAN, Up: Intrinsic Procedures -9.153 `ITIME' -- Get current local time subroutine (hour/minutes/seconds) +9.160 'ITIME' -- Get current local time subroutine (hour/minutes/seconds) ========================================================================= _Description_: - `IDATE(VALUES)' Fills VALUES with the numerical values at the - current local time. The hour (in the range 1-24), minute (in the + 'ITIME(VALUES)' Fills VALUES with the numerical values at the + current local time. The hour (in the range 1-24), minute (in the range 1-60), and seconds (in the range 1-60) appear in elements 1, 2, and 3 of VALUES, respectively. + This intrinsic routine is provided for backwards compatibility with + GNU Fortran 77. In new code, programmers should consider the use + of the *note DATE_AND_TIME:: intrinsic defined by the Fortran 95 + standard. + _Standard_: GNU extension @@ -12564,11 +13840,11 @@ _Class_: Subroutine _Syntax_: - `CALL ITIME(VALUES)' + 'CALL ITIME(VALUES)' _Arguments_: - VALUES The type shall be `INTEGER, DIMENSION(3)' and - the kind shall be the default integer kind. + VALUES The type shall be 'INTEGER, DIMENSION(3)' and + the kind shall be the default integer kind. _Return value_: Does not return anything. @@ -12582,17 +13858,19 @@ _Example_: print *, tarray(3) end program test_itime +_See also_: + *note DATE_AND_TIME:: + File: gfortran.info, Node: KILL, Next: KIND, Prev: ITIME, Up: Intrinsic Procedures -9.154 `KILL' -- Send a signal to a process +9.161 'KILL' -- Send a signal to a process ========================================== _Description_: - _Standard_: Sends the signal specified by SIGNAL to the process PID. See - `kill(2)'. + 'kill(2)'. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -12601,15 +13879,15 @@ _Class_: Subroutine, function _Syntax_: - `CALL KILL(C, VALUE [, STATUS])' - `STATUS = KILL(C, VALUE)' + 'CALL KILL(C, VALUE [, STATUS])' + 'STATUS = KILL(C, VALUE)' _Arguments_: - C Shall be a scalar `INTEGER', with `INTENT(IN)' - VALUE Shall be a scalar `INTEGER', with `INTENT(IN)' - STATUS (Optional) status flag of type `INTEGER(4)' or - `INTEGER(8)'. Returns 0 on success, or a - system-specific error code otherwise. + C Shall be a scalar 'INTEGER', with 'INTENT(IN)' + VALUE Shall be a scalar 'INTEGER', with 'INTENT(IN)' + STATUS (Optional) status flag of type 'INTEGER(4)' or + 'INTEGER(8)'. Returns 0 on success, or a + system-specific error code otherwise. _See also_: *note ABORT::, *note EXIT:: @@ -12617,11 +13895,11 @@ _See also_: File: gfortran.info, Node: KIND, Next: LBOUND, Prev: KILL, Up: Intrinsic Procedures -9.155 `KIND' -- Kind of an entity +9.162 'KIND' -- Kind of an entity ================================= _Description_: - `KIND(X)' returns the kind value of the entity X. + 'KIND(X)' returns the kind value of the entity X. _Standard_: Fortran 95 and later @@ -12630,14 +13908,14 @@ _Class_: Inquiry function _Syntax_: - `K = KIND(X)' + 'K = KIND(X)' _Arguments_: - X Shall be of type `LOGICAL', `INTEGER', `REAL', - `COMPLEX' or `CHARACTER'. + X Shall be of type 'LOGICAL', 'INTEGER', 'REAL', + 'COMPLEX' or 'CHARACTER'. _Return value_: - The return value is a scalar of type `INTEGER' and of the default + The return value is a scalar of type 'INTEGER' and of the default integer kind. _Example_: @@ -12649,17 +13927,15 @@ _Example_: print *, "The default logical kind is ", kl end program test_kind - File: gfortran.info, Node: LBOUND, Next: LCOBOUND, Prev: KIND, Up: Intrinsic Procedures -9.156 `LBOUND' -- Lower dimension bounds of an array +9.163 'LBOUND' -- Lower dimension bounds of an array ==================================================== _Description_: - Returns the lower bounds of an array, or a single lower bound - along the DIM dimension. - + Returns the lower bounds of an array, or a single lower bound along + the DIM dimension. _Standard_: Fortran 95 and later, with KIND argument Fortran 2003 and later @@ -12667,24 +13943,24 @@ _Class_: Inquiry function _Syntax_: - `RESULT = LBOUND(ARRAY [, DIM [, KIND]])' + 'RESULT = LBOUND(ARRAY [, DIM [, KIND]])' _Arguments_: - ARRAY Shall be an array, of any type. - DIM (Optional) Shall be a scalar `INTEGER'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + ARRAY Shall be an array, of any type. + DIM (Optional) Shall be a scalar 'INTEGER'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. If DIM is absent, the result is an array of the lower bounds of ARRAY. If DIM is present, the result is a scalar corresponding to the lower - bound of the array along that dimension. If ARRAY is an - expression rather than a whole array or array structure component, - or if it has a zero extent along the relevant dimension, the lower - bound is taken to be 1. + bound of the array along that dimension. If ARRAY is an expression + rather than a whole array or array structure component, or if it + has a zero extent along the relevant dimension, the lower bound is + taken to be 1. _See also_: *note UBOUND::, *note LCOBOUND:: @@ -12692,13 +13968,12 @@ _See also_: File: gfortran.info, Node: LCOBOUND, Next: LEADZ, Prev: LBOUND, Up: Intrinsic Procedures -9.157 `LCOBOUND' -- Lower codimension bounds of an array +9.164 'LCOBOUND' -- Lower codimension bounds of an array ======================================================== _Description_: Returns the lower bounds of a coarray, or a single lower cobound along the DIM codimension. - _Standard_: Fortran 2008 and later @@ -12706,17 +13981,17 @@ _Class_: Inquiry function _Syntax_: - `RESULT = LCOBOUND(COARRAY [, DIM [, KIND]])' + 'RESULT = LCOBOUND(COARRAY [, DIM [, KIND]])' _Arguments_: - ARRAY Shall be an coarray, of any type. - DIM (Optional) Shall be a scalar `INTEGER'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + ARRAY Shall be an coarray, of any type. + DIM (Optional) Shall be a scalar 'INTEGER'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. If DIM is absent, the result is an array of the lower cobounds of COARRAY. If DIM is present, the result is a scalar corresponding to the @@ -12728,11 +14003,11 @@ _See also_: File: gfortran.info, Node: LEADZ, Next: LEN, Prev: LCOBOUND, Up: Intrinsic Procedures -9.158 `LEADZ' -- Number of leading zero bits of an integer +9.165 'LEADZ' -- Number of leading zero bits of an integer ========================================================== _Description_: - `LEADZ' returns the number of leading zero bits of an integer. + 'LEADZ' returns the number of leading zero bits of an integer. _Standard_: Fortran 2008 and later @@ -12741,14 +14016,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = LEADZ(I)' + 'RESULT = LEADZ(I)' _Arguments_: - I Shall be of type `INTEGER'. + I Shall be of type 'INTEGER'. _Return value_: - The type of the return value is the default `INTEGER'. If all the - bits of `I' are zero, the result value is `BIT_SIZE(I)'. + The type of the return value is the default 'INTEGER'. If all the + bits of 'I' are zero, the result value is 'BIT_SIZE(I)'. _Example_: PROGRAM test_leadz @@ -12762,7 +14037,7 @@ _See also_: File: gfortran.info, Node: LEN, Next: LEN_TRIM, Prev: LEADZ, Up: Intrinsic Procedures -9.159 `LEN' -- Length of a character entity +9.166 'LEN' -- Length of a character entity =========================================== _Description_: @@ -12778,23 +14053,23 @@ _Class_: Inquiry function _Syntax_: - `L = LEN(STRING [, KIND])' + 'L = LEN(STRING [, KIND])' _Arguments_: - STRING Shall be a scalar or array of type - `CHARACTER', with `INTENT(IN)' - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + STRING Shall be a scalar or array of type 'CHARACTER', + with 'INTENT(IN)' + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. _Specific names_: - Name Argument Return type Standard - `LEN(STRING)' `CHARACTER' `INTEGER' Fortran 77 and - later + Name Argument Return type Standard + 'LEN(STRING)' 'CHARACTER' 'INTEGER' Fortran 77 and + later _See also_: *note LEN_TRIM::, *note ADJUSTL::, *note ADJUSTR:: @@ -12802,7 +14077,7 @@ _See also_: File: gfortran.info, Node: LEN_TRIM, Next: LGE, Prev: LEN, Up: Intrinsic Procedures -9.160 `LEN_TRIM' -- Length of a character entity without trailing blank characters +9.167 'LEN_TRIM' -- Length of a character entity without trailing blank characters ================================================================================== _Description_: @@ -12816,17 +14091,17 @@ _Class_: Elemental function _Syntax_: - `RESULT = LEN_TRIM(STRING [, KIND])' + 'RESULT = LEN_TRIM(STRING [, KIND])' _Arguments_: - STRING Shall be a scalar of type `CHARACTER', with - `INTENT(IN)' - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + STRING Shall be a scalar of type 'CHARACTER', with + 'INTENT(IN)' + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. _See also_: @@ -12835,7 +14110,7 @@ _See also_: File: gfortran.info, Node: LGE, Next: LGT, Prev: LEN_TRIM, Up: Intrinsic Procedures -9.161 `LGE' -- Lexical greater than or equal +9.168 'LGE' -- Lexical greater than or equal ============================================ _Description_: @@ -12845,11 +14120,11 @@ _Description_: same length, the shorter is compared as if spaces were appended to it to form a value that has the same length as the longer. - In general, the lexical comparison intrinsics `LGE', `LGT', `LLE', - and `LLT' differ from the corresponding intrinsic operators - `.GE.', `.GT.', `.LE.', and `.LT.', in that the latter use the - processor's character ordering (which is not ASCII on some - targets), whereas the former always use the ASCII ordering. + In general, the lexical comparison intrinsics 'LGE', 'LGT', 'LLE', + and 'LLT' differ from the corresponding intrinsic operators '.GE.', + '.GT.', '.LE.', and '.LT.', in that the latter use the processor's + character ordering (which is not ASCII on some targets), whereas + the former always use the ASCII ordering. _Standard_: Fortran 77 and later @@ -12858,20 +14133,20 @@ _Class_: Elemental function _Syntax_: - `RESULT = LGE(STRING_A, STRING_B)' + 'RESULT = LGE(STRING_A, STRING_B)' _Arguments_: - STRING_A Shall be of default `CHARACTER' type. - STRING_B Shall be of default `CHARACTER' type. + STRING_A Shall be of default 'CHARACTER' type. + STRING_B Shall be of default 'CHARACTER' type. _Return value_: - Returns `.TRUE.' if `STRING_A >= STRING_B', and `.FALSE.' + Returns '.TRUE.' if 'STRING_A >= STRING_B', and '.FALSE.' otherwise, based on the ASCII ordering. _Specific names_: - Name Argument Return type Standard - `LGE(STRING_A,`CHARACTER' `LOGICAL' Fortran 77 and - STRING_B)' later + Name Argument Return type Standard + 'LGE(STRING_A, 'CHARACTER' 'LOGICAL' Fortran 77 and + STRING_B)' later _See also_: *note LGT::, *note LLE::, *note LLT:: @@ -12879,21 +14154,21 @@ _See also_: File: gfortran.info, Node: LGT, Next: LINK, Prev: LGE, Up: Intrinsic Procedures -9.162 `LGT' -- Lexical greater than +9.169 'LGT' -- Lexical greater than =================================== _Description_: Determines whether one string is lexically greater than another string, where the two strings are interpreted as containing ASCII character codes. If the String A and String B are not the same - length, the shorter is compared as if spaces were appended to it - to form a value that has the same length as the longer. + length, the shorter is compared as if spaces were appended to it to + form a value that has the same length as the longer. - In general, the lexical comparison intrinsics `LGE', `LGT', `LLE', - and `LLT' differ from the corresponding intrinsic operators - `.GE.', `.GT.', `.LE.', and `.LT.', in that the latter use the - processor's character ordering (which is not ASCII on some - targets), whereas the former always use the ASCII ordering. + In general, the lexical comparison intrinsics 'LGE', 'LGT', 'LLE', + and 'LLT' differ from the corresponding intrinsic operators '.GE.', + '.GT.', '.LE.', and '.LT.', in that the latter use the processor's + character ordering (which is not ASCII on some targets), whereas + the former always use the ASCII ordering. _Standard_: Fortran 77 and later @@ -12902,20 +14177,20 @@ _Class_: Elemental function _Syntax_: - `RESULT = LGT(STRING_A, STRING_B)' + 'RESULT = LGT(STRING_A, STRING_B)' _Arguments_: - STRING_A Shall be of default `CHARACTER' type. - STRING_B Shall be of default `CHARACTER' type. + STRING_A Shall be of default 'CHARACTER' type. + STRING_B Shall be of default 'CHARACTER' type. _Return value_: - Returns `.TRUE.' if `STRING_A > STRING_B', and `.FALSE.' - otherwise, based on the ASCII ordering. + Returns '.TRUE.' if 'STRING_A > STRING_B', and '.FALSE.' otherwise, + based on the ASCII ordering. _Specific names_: - Name Argument Return type Standard - `LGT(STRING_A,`CHARACTER' `LOGICAL' Fortran 77 and - STRING_B)' later + Name Argument Return type Standard + 'LGT(STRING_A, 'CHARACTER' 'LOGICAL' Fortran 77 and + STRING_B)' later _See also_: *note LGE::, *note LLE::, *note LLT:: @@ -12923,15 +14198,15 @@ _See also_: File: gfortran.info, Node: LINK, Next: LLE, Prev: LGT, Up: Intrinsic Procedures -9.163 `LINK' -- Create a hard link +9.170 'LINK' -- Create a hard link ================================== _Description_: - Makes a (hard) link from file PATH1 to PATH2. A null character - (`CHAR(0)') can be used to mark the end of the names in PATH1 and + Makes a (hard) link from file PATH1 to PATH2. A null character + ('CHAR(0)') can be used to mark the end of the names in PATH1 and PATH2; otherwise, trailing blanks in the file names are ignored. If the STATUS argument is supplied, it contains 0 on success or a - nonzero error code upon return; see `link(2)'. + nonzero error code upon return; see 'link(2)'. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -12943,13 +14218,13 @@ _Class_: Subroutine, function _Syntax_: - `CALL LINK(PATH1, PATH2 [, STATUS])' - `STATUS = LINK(PATH1, PATH2)' + 'CALL LINK(PATH1, PATH2 [, STATUS])' + 'STATUS = LINK(PATH1, PATH2)' _Arguments_: - PATH1 Shall be of default `CHARACTER' type. - PATH2 Shall be of default `CHARACTER' type. - STATUS (Optional) Shall be of default `INTEGER' type. + PATH1 Shall be of default 'CHARACTER' type. + PATH2 Shall be of default 'CHARACTER' type. + STATUS (Optional) Shall be of default 'INTEGER' type. _See also_: *note SYMLNK::, *note UNLINK:: @@ -12957,22 +14232,21 @@ _See also_: File: gfortran.info, Node: LLE, Next: LLT, Prev: LINK, Up: Intrinsic Procedures -9.164 `LLE' -- Lexical less than or equal +9.171 'LLE' -- Lexical less than or equal ========================================= _Description_: Determines whether one string is lexically less than or equal to - another string, where the two strings are interpreted as - containing ASCII character codes. If the String A and String B - are not the same length, the shorter is compared as if spaces were - appended to it to form a value that has the same length as the - longer. + another string, where the two strings are interpreted as containing + ASCII character codes. If the String A and String B are not the + same length, the shorter is compared as if spaces were appended to + it to form a value that has the same length as the longer. - In general, the lexical comparison intrinsics `LGE', `LGT', `LLE', - and `LLT' differ from the corresponding intrinsic operators - `.GE.', `.GT.', `.LE.', and `.LT.', in that the latter use the - processor's character ordering (which is not ASCII on some - targets), whereas the former always use the ASCII ordering. + In general, the lexical comparison intrinsics 'LGE', 'LGT', 'LLE', + and 'LLT' differ from the corresponding intrinsic operators '.GE.', + '.GT.', '.LE.', and '.LT.', in that the latter use the processor's + character ordering (which is not ASCII on some targets), whereas + the former always use the ASCII ordering. _Standard_: Fortran 77 and later @@ -12981,20 +14255,20 @@ _Class_: Elemental function _Syntax_: - `RESULT = LLE(STRING_A, STRING_B)' + 'RESULT = LLE(STRING_A, STRING_B)' _Arguments_: - STRING_A Shall be of default `CHARACTER' type. - STRING_B Shall be of default `CHARACTER' type. + STRING_A Shall be of default 'CHARACTER' type. + STRING_B Shall be of default 'CHARACTER' type. _Return value_: - Returns `.TRUE.' if `STRING_A <= STRING_B', and `.FALSE.' + Returns '.TRUE.' if 'STRING_A <= STRING_B', and '.FALSE.' otherwise, based on the ASCII ordering. _Specific names_: - Name Argument Return type Standard - `LLE(STRING_A,`CHARACTER' `LOGICAL' Fortran 77 and - STRING_B)' later + Name Argument Return type Standard + 'LLE(STRING_A, 'CHARACTER' 'LOGICAL' Fortran 77 and + STRING_B)' later _See also_: *note LGE::, *note LGT::, *note LLT:: @@ -13002,21 +14276,21 @@ _See also_: File: gfortran.info, Node: LLT, Next: LNBLNK, Prev: LLE, Up: Intrinsic Procedures -9.165 `LLT' -- Lexical less than +9.172 'LLT' -- Lexical less than ================================ _Description_: Determines whether one string is lexically less than another string, where the two strings are interpreted as containing ASCII character codes. If the String A and String B are not the same - length, the shorter is compared as if spaces were appended to it - to form a value that has the same length as the longer. + length, the shorter is compared as if spaces were appended to it to + form a value that has the same length as the longer. - In general, the lexical comparison intrinsics `LGE', `LGT', `LLE', - and `LLT' differ from the corresponding intrinsic operators - `.GE.', `.GT.', `.LE.', and `.LT.', in that the latter use the - processor's character ordering (which is not ASCII on some - targets), whereas the former always use the ASCII ordering. + In general, the lexical comparison intrinsics 'LGE', 'LGT', 'LLE', + and 'LLT' differ from the corresponding intrinsic operators '.GE.', + '.GT.', '.LE.', and '.LT.', in that the latter use the processor's + character ordering (which is not ASCII on some targets), whereas + the former always use the ASCII ordering. _Standard_: Fortran 77 and later @@ -13025,20 +14299,20 @@ _Class_: Elemental function _Syntax_: - `RESULT = LLT(STRING_A, STRING_B)' + 'RESULT = LLT(STRING_A, STRING_B)' _Arguments_: - STRING_A Shall be of default `CHARACTER' type. - STRING_B Shall be of default `CHARACTER' type. + STRING_A Shall be of default 'CHARACTER' type. + STRING_B Shall be of default 'CHARACTER' type. _Return value_: - Returns `.TRUE.' if `STRING_A < STRING_B', and `.FALSE.' - otherwise, based on the ASCII ordering. + Returns '.TRUE.' if 'STRING_A < STRING_B', and '.FALSE.' otherwise, + based on the ASCII ordering. _Specific names_: - Name Argument Return type Standard - `LLT(STRING_A,`CHARACTER' `LOGICAL' Fortran 77 and - STRING_B)' later + Name Argument Return type Standard + 'LLT(STRING_A, 'CHARACTER' 'LOGICAL' Fortran 77 and + STRING_B)' later _See also_: *note LGE::, *note LGT::, *note LLE:: @@ -13046,12 +14320,12 @@ _See also_: File: gfortran.info, Node: LNBLNK, Next: LOC, Prev: LLT, Up: Intrinsic Procedures -9.166 `LNBLNK' -- Index of the last non-blank character in a string +9.173 'LNBLNK' -- Index of the last non-blank character in a string =================================================================== _Description_: Returns the length of a character string, ignoring any trailing - blanks. This is identical to the standard `LEN_TRIM' intrinsic, + blanks. This is identical to the standard 'LEN_TRIM' intrinsic, and is only included for backwards compatibility. _Standard_: @@ -13061,14 +14335,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = LNBLNK(STRING)' + 'RESULT = LNBLNK(STRING)' _Arguments_: - STRING Shall be a scalar of type `CHARACTER', with - `INTENT(IN)' + STRING Shall be a scalar of type 'CHARACTER', with + 'INTENT(IN)' _Return value_: - The return value is of `INTEGER(kind=4)' type. + The return value is of 'INTEGER(kind=4)' type. _See also_: *note INDEX intrinsic::, *note LEN_TRIM:: @@ -13076,11 +14350,11 @@ _See also_: File: gfortran.info, Node: LOC, Next: LOG, Prev: LNBLNK, Up: Intrinsic Procedures -9.167 `LOC' -- Returns the address of a variable +9.174 'LOC' -- Returns the address of a variable ================================================ _Description_: - `LOC(X)' returns the address of X as an integer. + 'LOC(X)' returns the address of X as an integer. _Standard_: GNU extension @@ -13089,13 +14363,13 @@ _Class_: Inquiry function _Syntax_: - `RESULT = LOC(X)' + 'RESULT = LOC(X)' _Arguments_: - X Variable of any type. + X Variable of any type. _Return value_: - The return value is of type `INTEGER', with a `KIND' corresponding + The return value is of type 'INTEGER', with a 'KIND' corresponding to the size (in bytes) of a memory address on the target machine. _Example_: @@ -13109,11 +14383,11 @@ _Example_: File: gfortran.info, Node: LOG, Next: LOG10, Prev: LOC, Up: Intrinsic Procedures -9.168 `LOG' -- Natural logarithm function +9.175 'LOG' -- Natural logarithm function ========================================= _Description_: - `LOG(X)' computes the natural logarithm of X, i.e. the logarithm + 'LOG(X)' computes the natural logarithm of X, i.e. the logarithm to the base e. _Standard_: @@ -13123,14 +14397,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = LOG(X)' + 'RESULT = LOG(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: - The return value is of type `REAL' or `COMPLEX'. The kind type - parameter is the same as X. If X is `COMPLEX', the imaginary part + The return value is of type 'REAL' or 'COMPLEX'. The kind type + parameter is the same as X. If X is 'COMPLEX', the imaginary part \omega is in the range -\pi < \omega \leq \pi. _Example_: @@ -13142,24 +14416,24 @@ _Example_: end program test_log _Specific names_: - Name Argument Return type Standard - `ALOG(X)' `REAL(4) X' `REAL(4)' f95, gnu - `DLOG(X)' `REAL(8) X' `REAL(8)' f95, gnu - `CLOG(X)' `COMPLEX(4) `COMPLEX(4)' f95, gnu - X' - `ZLOG(X)' `COMPLEX(8) `COMPLEX(8)' f95, gnu - X' - `CDLOG(X)' `COMPLEX(8) `COMPLEX(8)' f95, gnu - X' + Name Argument Return type Standard + 'ALOG(X)' 'REAL(4) X' 'REAL(4)' f95, gnu + 'DLOG(X)' 'REAL(8) X' 'REAL(8)' f95, gnu + 'CLOG(X)' 'COMPLEX(4) 'COMPLEX(4)' f95, gnu + X' + 'ZLOG(X)' 'COMPLEX(8) 'COMPLEX(8)' f95, gnu + X' + 'CDLOG(X)' 'COMPLEX(8) 'COMPLEX(8)' f95, gnu + X' File: gfortran.info, Node: LOG10, Next: LOG_GAMMA, Prev: LOG, Up: Intrinsic Procedures -9.169 `LOG10' -- Base 10 logarithm function +9.176 'LOG10' -- Base 10 logarithm function =========================================== _Description_: - `LOG10(X)' computes the base 10 logarithm of X. + 'LOG10(X)' computes the base 10 logarithm of X. _Standard_: Fortran 77 and later @@ -13168,13 +14442,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = LOG10(X)' + 'RESULT = LOG10(X)' _Arguments_: - X The type shall be `REAL'. + X The type shall be 'REAL'. _Return value_: - The return value is of type `REAL' or `COMPLEX'. The kind type + The return value is of type 'REAL' or 'COMPLEX'. The kind type parameter is the same as X. _Example_: @@ -13184,20 +14458,20 @@ _Example_: end program test_log10 _Specific names_: - Name Argument Return type Standard - `ALOG10(X)' `REAL(4) X' `REAL(4)' Fortran 95 and - later - `DLOG10(X)' `REAL(8) X' `REAL(8)' Fortran 95 and - later + Name Argument Return type Standard + 'ALOG10(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and + later + 'DLOG10(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and + later File: gfortran.info, Node: LOG_GAMMA, Next: LOGICAL, Prev: LOG10, Up: Intrinsic Procedures -9.170 `LOG_GAMMA' -- Logarithm of the Gamma function +9.177 'LOG_GAMMA' -- Logarithm of the Gamma function ==================================================== _Description_: - `LOG_GAMMA(X)' computes the natural logarithm of the absolute value + 'LOG_GAMMA(X)' computes the natural logarithm of the absolute value of the Gamma (\Gamma) function. _Standard_: @@ -13207,14 +14481,14 @@ _Class_: Elemental function _Syntax_: - `X = LOG_GAMMA(X)' + 'X = LOG_GAMMA(X)' _Arguments_: - X Shall be of type `REAL' and neither zero nor a - negative integer. + X Shall be of type 'REAL' and neither zero nor a + negative integer. _Return value_: - The return value is of type `REAL' of the same kind as X. + The return value is of type 'REAL' of the same kind as X. _Example_: program test_log_gamma @@ -13223,23 +14497,22 @@ _Example_: end program test_log_gamma _Specific names_: - Name Argument Return type Standard - `LGAMMA(X)' `REAL(4) X' `REAL(4)' GNU Extension - `ALGAMA(X)' `REAL(4) X' `REAL(4)' GNU Extension - `DLGAMA(X)' `REAL(8) X' `REAL(8)' GNU Extension + Name Argument Return type Standard + 'LGAMMA(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'ALGAMA(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DLGAMA(X)' 'REAL(8) X' 'REAL(8)' GNU Extension _See also_: Gamma function: *note GAMMA:: - File: gfortran.info, Node: LOGICAL, Next: LONG, Prev: LOG_GAMMA, Up: Intrinsic Procedures -9.171 `LOGICAL' -- Convert to logical type +9.178 'LOGICAL' -- Convert to logical type ========================================== _Description_: - Converts one kind of `LOGICAL' variable to another. + Converts one kind of 'LOGICAL' variable to another. _Standard_: Fortran 95 and later @@ -13248,16 +14521,16 @@ _Class_: Elemental function _Syntax_: - `RESULT = LOGICAL(L [, KIND])' + 'RESULT = LOGICAL(L [, KIND])' _Arguments_: - L The type shall be `LOGICAL'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + L The type shall be 'LOGICAL'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is a `LOGICAL' value equal to L, with a kind + The return value is a 'LOGICAL' value equal to L, with a kind corresponding to KIND, or of the default logical kind if KIND is not given. @@ -13267,14 +14540,14 @@ _See also_: File: gfortran.info, Node: LONG, Next: LSHIFT, Prev: LOGICAL, Up: Intrinsic Procedures -9.172 `LONG' -- Convert to integer type +9.179 'LONG' -- Convert to integer type ======================================= _Description_: - Convert to a `KIND=4' integer type, which is the same size as a C - `long' integer. This is equivalent to the standard `INT' - intrinsic with an optional argument of `KIND=4', and is only - included for backwards compatibility. + Convert to a 'KIND=4' integer type, which is the same size as a C + 'long' integer. This is equivalent to the standard 'INT' intrinsic + with an optional argument of 'KIND=4', and is only included for + backwards compatibility. _Standard_: GNU extension @@ -13283,14 +14556,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = LONG(A)' + 'RESULT = LONG(A)' _Arguments_: - A Shall be of type `INTEGER', `REAL', or - `COMPLEX'. + A Shall be of type 'INTEGER', 'REAL', or + 'COMPLEX'. _Return value_: - The return value is a `INTEGER(4)' variable. + The return value is a 'INTEGER(4)' variable. _See also_: *note INT::, *note INT2::, *note INT8:: @@ -13298,18 +14571,18 @@ _See also_: File: gfortran.info, Node: LSHIFT, Next: LSTAT, Prev: LONG, Up: Intrinsic Procedures -9.173 `LSHIFT' -- Left shift bits +9.180 'LSHIFT' -- Left shift bits ================================= _Description_: - `LSHIFT' returns a value corresponding to I with all of the bits + 'LSHIFT' returns a value corresponding to I with all of the bits shifted left by SHIFT places. If the absolute value of SHIFT is - greater than `BIT_SIZE(I)', the value is undefined. Bits shifted + greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted out from the left end are lost; zeros are shifted in from the opposite end. - This function has been superseded by the `ISHFT' intrinsic, which - is standard in Fortran 95 and later, and the `SHIFTL' intrinsic, + This function has been superseded by the 'ISHFT' intrinsic, which + is standard in Fortran 95 and later, and the 'SHIFTL' intrinsic, which is standard in Fortran 2008 and later. _Standard_: @@ -13319,32 +14592,31 @@ _Class_: Elemental function _Syntax_: - `RESULT = LSHIFT(I, SHIFT)' + 'RESULT = LSHIFT(I, SHIFT)' _Arguments_: - I The type shall be `INTEGER'. - SHIFT The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + SHIFT The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. _See also_: *note ISHFT::, *note ISHFTC::, *note RSHIFT::, *note SHIFTA::, *note SHIFTL::, *note SHIFTR:: - File: gfortran.info, Node: LSTAT, Next: LTIME, Prev: LSHIFT, Up: Intrinsic Procedures -9.174 `LSTAT' -- Get file status +9.181 'LSTAT' -- Get file status ================================ _Description_: - `LSTAT' is identical to *note STAT::, except that if path is a + 'LSTAT' is identical to *note STAT::, except that if path is a symbolic link, then the link itself is statted, not the file that it refers to. - The elements in `VALUES' are the same as described by *note STAT::. + The elements in 'VALUES' are the same as described by *note STAT::. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -13356,16 +14628,16 @@ _Class_: Subroutine, function _Syntax_: - `CALL LSTAT(NAME, VALUES [, STATUS])' - `STATUS = LSTAT(NAME, VALUES)' + 'CALL LSTAT(NAME, VALUES [, STATUS])' + 'STATUS = LSTAT(NAME, VALUES)' _Arguments_: - NAME The type shall be `CHARACTER' of the default - kind, a valid path within the file system. - VALUES The type shall be `INTEGER(4), DIMENSION(13)'. - STATUS (Optional) status flag of type `INTEGER(4)'. - Returns 0 on success and a system specific - error code otherwise. + NAME The type shall be 'CHARACTER' of the default + kind, a valid path within the file system. + VALUES The type shall be 'INTEGER(4), DIMENSION(13)'. + STATUS (Optional) status flag of type 'INTEGER(4)'. + Returns 0 on success and a system specific error + code otherwise. _Example_: See *note STAT:: for an example. @@ -13376,13 +14648,18 @@ _See also_: File: gfortran.info, Node: LTIME, Next: MALLOC, Prev: LSTAT, Up: Intrinsic Procedures -9.175 `LTIME' -- Convert time to local time info +9.182 'LTIME' -- Convert time to local time info ================================================ _Description_: - Given a system time value TIME (as provided by the `TIME8' + Given a system time value TIME (as provided by the *note TIME:: intrinsic), fills VALUES with values extracted from it appropriate - to the local time zone using `localtime(3)'. + to the local time zone using 'localtime(3)'. + + This intrinsic routine is provided for backwards compatibility with + GNU Fortran 77. In new code, programmers should consider the use + of the *note DATE_AND_TIME:: intrinsic defined by the Fortran 95 + standard. _Standard_: GNU extension @@ -13391,54 +14668,46 @@ _Class_: Subroutine _Syntax_: - `CALL LTIME(TIME, VALUES)' + 'CALL LTIME(TIME, VALUES)' _Arguments_: - TIME An `INTEGER' scalar expression corresponding - to a system time, with `INTENT(IN)'. - VALUES A default `INTEGER' array with 9 elements, - with `INTENT(OUT)'. + TIME An 'INTEGER' scalar expression corresponding to + a system time, with 'INTENT(IN)'. + VALUES A default 'INTEGER' array with 9 elements, with + 'INTENT(OUT)'. _Return value_: The elements of VALUES are assigned as follows: 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds - 2. Minutes after the hour, range 0-59 - 3. Hours past midnight, range 0-23 - - 4. Day of month, range 0-31 - - 5. Number of months since January, range 0-12 - + 4. Day of month, range 1-31 + 5. Number of months since January, range 0-11 6. Years since 1900 - 7. Number of days since Sunday, range 0-6 - - 8. Days since January 1 - + 8. Days since January 1, range 0-365 9. Daylight savings indicator: positive if daylight savings is in effect, zero if not, and negative if the information is not available. _See also_: - *note CTIME::, *note GMTIME::, *note TIME::, *note TIME8:: - + *note DATE_AND_TIME::, *note CTIME::, *note GMTIME::, *note TIME::, + *note TIME8:: File: gfortran.info, Node: MALLOC, Next: MASKL, Prev: LTIME, Up: Intrinsic Procedures -9.176 `MALLOC' -- Allocate dynamic memory +9.183 'MALLOC' -- Allocate dynamic memory ========================================= _Description_: - `MALLOC(SIZE)' allocates SIZE bytes of dynamic memory and returns - the address of the allocated memory. The `MALLOC' intrinsic is an + 'MALLOC(SIZE)' allocates SIZE bytes of dynamic memory and returns + the address of the allocated memory. The 'MALLOC' intrinsic is an extension intended to be used with Cray pointers, and is provided - in GNU Fortran to allow the user to compile legacy code. For new + in GNU Fortran to allow the user to compile legacy code. For new code using Fortran 95 pointers, the memory allocation intrinsic is - `ALLOCATE'. + 'ALLOCATE'. _Standard_: GNU extension @@ -13447,18 +14716,18 @@ _Class_: Function _Syntax_: - `PTR = MALLOC(SIZE)' + 'PTR = MALLOC(SIZE)' _Arguments_: - SIZE The type shall be `INTEGER'. + SIZE The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER(K)', with K such that - variables of type `INTEGER(K)' have the same size as C pointers - (`sizeof(void *)'). + The return value is of type 'INTEGER(K)', with K such that + variables of type 'INTEGER(K)' have the same size as C pointers + ('sizeof(void *)'). _Example_: - The following example demonstrates the use of `MALLOC' and `FREE' + The following example demonstrates the use of 'MALLOC' and 'FREE' with Cray pointers. program test_malloc @@ -13485,11 +14754,11 @@ _See also_: File: gfortran.info, Node: MASKL, Next: MASKR, Prev: MALLOC, Up: Intrinsic Procedures -9.177 `MASKL' -- Left justified mask +9.184 'MASKL' -- Left justified mask ==================================== _Description_: - `MASKL(I[, KIND])' has its leftmost I bits set to 1, and the + 'MASKL(I[, KIND])' has its leftmost I bits set to 1, and the remaining bits set to 0. _Standard_: @@ -13499,15 +14768,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = MASKL(I[, KIND])' + 'RESULT = MASKL(I[, KIND])' _Arguments_: - I Shall be of type `INTEGER'. - KIND Shall be a scalar constant expression of type - `INTEGER'. + I Shall be of type 'INTEGER'. + KIND Shall be a scalar constant expression of type + 'INTEGER'. _Return value_: - The return value is of type `INTEGER'. If KIND is present, it + The return value is of type 'INTEGER'. If KIND is present, it specifies the kind value of the return type; otherwise, it is of the default integer kind. @@ -13517,11 +14786,11 @@ _See also_: File: gfortran.info, Node: MASKR, Next: MATMUL, Prev: MASKL, Up: Intrinsic Procedures -9.178 `MASKR' -- Right justified mask +9.185 'MASKR' -- Right justified mask ===================================== _Description_: - `MASKL(I[, KIND])' has its rightmost I bits set to 1, and the + 'MASKL(I[, KIND])' has its rightmost I bits set to 1, and the remaining bits set to 0. _Standard_: @@ -13531,15 +14800,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = MASKR(I[, KIND])' + 'RESULT = MASKR(I[, KIND])' _Arguments_: - I Shall be of type `INTEGER'. - KIND Shall be a scalar constant expression of type - `INTEGER'. + I Shall be of type 'INTEGER'. + KIND Shall be a scalar constant expression of type + 'INTEGER'. _Return value_: - The return value is of type `INTEGER'. If KIND is present, it + The return value is of type 'INTEGER'. If KIND is present, it specifies the kind value of the return type; otherwise, it is of the default integer kind. @@ -13549,7 +14818,7 @@ _See also_: File: gfortran.info, Node: MATMUL, Next: MAX, Prev: MASKR, Up: Intrinsic Procedures -9.179 `MATMUL' -- matrix multiplication +9.186 'MATMUL' -- matrix multiplication ======================================= _Description_: @@ -13562,29 +14831,29 @@ _Class_: Transformational function _Syntax_: - `RESULT = MATMUL(MATRIX_A, MATRIX_B)' + 'RESULT = MATMUL(MATRIX_A, MATRIX_B)' _Arguments_: - MATRIX_A An array of `INTEGER', `REAL', `COMPLEX', or - `LOGICAL' type, with a rank of one or two. - MATRIX_B An array of `INTEGER', `REAL', or `COMPLEX' - type if MATRIX_A is of a numeric type; - otherwise, an array of `LOGICAL' type. The - rank shall be one or two, and the first (or - only) dimension of MATRIX_B shall be equal to - the last (or only) dimension of MATRIX_A. + MATRIX_A An array of 'INTEGER', 'REAL', 'COMPLEX', or + 'LOGICAL' type, with a rank of one or two. + MATRIX_B An array of 'INTEGER', 'REAL', or 'COMPLEX' type + if MATRIX_A is of a numeric type; otherwise, an + array of 'LOGICAL' type. The rank shall be one + or two, and the first (or only) dimension of + MATRIX_B shall be equal to the last (or only) + dimension of MATRIX_A. _Return value_: The matrix product of MATRIX_A and MATRIX_B. The type and kind of the result follow the usual type and kind promotion rules, as for - the `*' or `.AND.' operators. + the '*' or '.AND.' operators. _See also_: File: gfortran.info, Node: MAX, Next: MAXEXPONENT, Prev: MATMUL, Up: Intrinsic Procedures -9.180 `MAX' -- Maximum value of an argument list +9.187 'MAX' -- Maximum value of an argument list ================================================ _Description_: @@ -13597,44 +14866,43 @@ _Class_: Elemental function _Syntax_: - `RESULT = MAX(A1, A2 [, A3 [, ...]])' + 'RESULT = MAX(A1, A2 [, A3 [, ...]])' _Arguments_: - A1 The type shall be `INTEGER' or `REAL'. - A2, A3, An expression of the same type and kind as A1. - ... (As a GNU extension, arguments of different - kinds are permitted.) + A1 The type shall be 'INTEGER' or 'REAL'. + A2, A3, An expression of the same type and kind as A1. + ... (As a GNU extension, arguments of different + kinds are permitted.) _Return value_: The return value corresponds to the maximum value among the arguments, and has the same type and kind as the first argument. _Specific names_: - Name Argument Return type Standard - `MAX0(A1)' `INTEGER(4) `INTEGER(4)' Fortran 77 and - A1' later - `AMAX0(A1)' `INTEGER(4) `REAL(MAX(X))'Fortran 77 and - A1' later - `MAX1(A1)' `REAL A1' `INT(MAX(X))' Fortran 77 and - later - `AMAX1(A1)' `REAL(4) A1' `REAL(4)' Fortran 77 and - later - `DMAX1(A1)' `REAL(8) A1' `REAL(8)' Fortran 77 and - later + Name Argument Return type Standard + 'MAX0(A1)' 'INTEGER(4) 'INTEGER(4)' Fortran 77 and + A1' later + 'AMAX0(A1)' 'INTEGER(4) 'REAL(MAX(X))' Fortran 77 and + A1' later + 'MAX1(A1)' 'REAL A1' 'INT(MAX(X))' Fortran 77 and + later + 'AMAX1(A1)' 'REAL(4) A1' 'REAL(4)' Fortran 77 and + later + 'DMAX1(A1)' 'REAL(8) A1' 'REAL(8)' Fortran 77 and + later _See also_: *note MAXLOC:: *note MAXVAL::, *note MIN:: - File: gfortran.info, Node: MAXEXPONENT, Next: MAXLOC, Prev: MAX, Up: Intrinsic Procedures -9.181 `MAXEXPONENT' -- Maximum exponent of a real kind +9.188 'MAXEXPONENT' -- Maximum exponent of a real kind ====================================================== _Description_: - `MAXEXPONENT(X)' returns the maximum exponent in the model of the - type of `X'. + 'MAXEXPONENT(X)' returns the maximum exponent in the model of the + type of 'X'. _Standard_: Fortran 95 and later @@ -13643,13 +14911,13 @@ _Class_: Inquiry function _Syntax_: - `RESULT = MAXEXPONENT(X)' + 'RESULT = MAXEXPONENT(X)' _Arguments_: - X Shall be of type `REAL'. + X Shall be of type 'REAL'. _Return value_: - The return value is of type `INTEGER' and of the default integer + The return value is of type 'INTEGER' and of the default integer kind. _Example_: @@ -13664,7 +14932,7 @@ _Example_: File: gfortran.info, Node: MAXLOC, Next: MAXVAL, Prev: MAXEXPONENT, Up: Intrinsic Procedures -9.182 `MAXLOC' -- Location of the maximum value within an array +9.189 'MAXLOC' -- Location of the maximum value within an array =============================================================== _Description_: @@ -13672,13 +14940,13 @@ _Description_: maximum value, or, if the DIM argument is supplied, determines the locations of the maximum element along each row of the array in the DIM direction. If MASK is present, only the elements for which - MASK is `.TRUE.' are considered. If more than one element in the + MASK is '.TRUE.' are considered. If more than one element in the array has the maximum value, the location returned is that of the first such element in array element order. If the array has zero - size, or all of the elements of MASK are `.FALSE.', then the - result is an array of zeroes. Similarly, if DIM is supplied and - all of the elements of MASK along a given row are zero, the result - value for that row is zero. + size, or all of the elements of MASK are '.FALSE.', then the result + is an array of zeroes. Similarly, if DIM is supplied and all of + the elements of MASK along a given row are zero, the result value + for that row is zero. _Standard_: Fortran 95 and later @@ -13687,17 +14955,17 @@ _Class_: Transformational function _Syntax_: - `RESULT = MAXLOC(ARRAY, DIM [, MASK])' - `RESULT = MAXLOC(ARRAY [, MASK])' + 'RESULT = MAXLOC(ARRAY, DIM [, MASK])' + 'RESULT = MAXLOC(ARRAY [, MASK])' _Arguments_: - ARRAY Shall be an array of type `INTEGER' or `REAL'. - DIM (Optional) Shall be a scalar of type - `INTEGER', with a value between one and the - rank of ARRAY, inclusive. It may not be an - optional dummy argument. - MASK Shall be an array of type `LOGICAL', and - conformable with ARRAY. + ARRAY Shall be an array of type 'INTEGER' or 'REAL'. + DIM (Optional) Shall be a scalar of type 'INTEGER', + with a value between one and the rank of ARRAY, + inclusive. It may not be an optional dummy + argument. + MASK Shall be an array of type 'LOGICAL', and + conformable with ARRAY. _Return value_: If DIM is absent, the result is a rank-one array with a length @@ -13705,26 +14973,25 @@ _Return value_: array with a rank one less than the rank of ARRAY, and a size corresponding to the size of ARRAY with the DIM dimension removed. If DIM is present and ARRAY has a rank of one, the result is a - scalar. In all cases, the result is of default `INTEGER' type. + scalar. In all cases, the result is of default 'INTEGER' type. _See also_: *note MAX::, *note MAXVAL:: - File: gfortran.info, Node: MAXVAL, Next: MCLOCK, Prev: MAXLOC, Up: Intrinsic Procedures -9.183 `MAXVAL' -- Maximum value of an array +9.190 'MAXVAL' -- Maximum value of an array =========================================== _Description_: - Determines the maximum value of the elements in an array value, - or, if the DIM argument is supplied, determines the maximum value - along each row of the array in the DIM direction. If MASK is - present, only the elements for which MASK is `.TRUE.' are - considered. If the array has zero size, or all of the elements of - MASK are `.FALSE.', then the result is `-HUGE(ARRAY)' if ARRAY is - numeric, or a string of nulls if ARRAY is of character type. + Determines the maximum value of the elements in an array value, or, + if the DIM argument is supplied, determines the maximum value along + each row of the array in the DIM direction. If MASK is present, + only the elements for which MASK is '.TRUE.' are considered. If + the array has zero size, or all of the elements of MASK are + '.FALSE.', then the result is '-HUGE(ARRAY)' if ARRAY is numeric, + or a string of nulls if ARRAY is of character type. _Standard_: Fortran 95 and later @@ -13733,17 +15000,17 @@ _Class_: Transformational function _Syntax_: - `RESULT = MAXVAL(ARRAY, DIM [, MASK])' - `RESULT = MAXVAL(ARRAY [, MASK])' + 'RESULT = MAXVAL(ARRAY, DIM [, MASK])' + 'RESULT = MAXVAL(ARRAY [, MASK])' _Arguments_: - ARRAY Shall be an array of type `INTEGER' or `REAL'. - DIM (Optional) Shall be a scalar of type - `INTEGER', with a value between one and the - rank of ARRAY, inclusive. It may not be an - optional dummy argument. - MASK Shall be an array of type `LOGICAL', and - conformable with ARRAY. + ARRAY Shall be an array of type 'INTEGER' or 'REAL'. + DIM (Optional) Shall be a scalar of type 'INTEGER', + with a value between one and the rank of ARRAY, + inclusive. It may not be an optional dummy + argument. + MASK Shall be an array of type 'LOGICAL', and + conformable with ARRAY. _Return value_: If DIM is absent, or if ARRAY has a rank of one, the result is a @@ -13758,15 +15025,15 @@ _See also_: File: gfortran.info, Node: MCLOCK, Next: MCLOCK8, Prev: MAXVAL, Up: Intrinsic Procedures -9.184 `MCLOCK' -- Time function +9.191 'MCLOCK' -- Time function =============================== _Description_: Returns the number of clock ticks since the start of the process, - based on the function `clock(3)' in the C standard library. + based on the function 'clock(3)' in the C standard library. This intrinsic is not fully portable, such as to systems with - 32-bit `INTEGER' types but supporting times wider than 32 bits. + 32-bit 'INTEGER' types but supporting times wider than 32 bits. Therefore, the values returned by this intrinsic might be, or become, negative, or numerically less than previous values, during a single run of the compiled program. @@ -13778,36 +15045,34 @@ _Class_: Function _Syntax_: - `RESULT = MCLOCK()' + 'RESULT = MCLOCK()' _Return value_: - The return value is a scalar of type `INTEGER(4)', equal to the - number of clock ticks since the start of the process, or `-1' if - the system does not support `clock(3)'. + The return value is a scalar of type 'INTEGER(4)', equal to the + number of clock ticks since the start of the process, or '-1' if + the system does not support 'clock(3)'. _See also_: - *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::, - *note TIME:: - + *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::, *note + TIME:: File: gfortran.info, Node: MCLOCK8, Next: MERGE, Prev: MCLOCK, Up: Intrinsic Procedures -9.185 `MCLOCK8' -- Time function (64-bit) +9.192 'MCLOCK8' -- Time function (64-bit) ========================================= _Description_: Returns the number of clock ticks since the start of the process, - based on the function `clock(3)' in the C standard library. + based on the function 'clock(3)' in the C standard library. _Warning:_ this intrinsic does not increase the range of the timing - values over that returned by `clock(3)'. On a system with a 32-bit - `clock(3)', `MCLOCK8' will return a 32-bit value, even though it - is converted to a 64-bit `INTEGER(8)' value. That means overflows - of the 32-bit value can still occur. Therefore, the values - returned by this intrinsic might be or become negative or - numerically less than previous values during a single run of the - compiled program. + values over that returned by 'clock(3)'. On a system with a 32-bit + 'clock(3)', 'MCLOCK8' will return a 32-bit value, even though it is + converted to a 64-bit 'INTEGER(8)' value. That means overflows of + the 32-bit value can still occur. Therefore, the values returned + by this intrinsic might be or become negative or numerically less + than previous values during a single run of the compiled program. _Standard_: GNU extension @@ -13816,28 +15081,27 @@ _Class_: Function _Syntax_: - `RESULT = MCLOCK8()' + 'RESULT = MCLOCK8()' _Return value_: - The return value is a scalar of type `INTEGER(8)', equal to the - number of clock ticks since the start of the process, or `-1' if - the system does not support `clock(3)'. + The return value is a scalar of type 'INTEGER(8)', equal to the + number of clock ticks since the start of the process, or '-1' if + the system does not support 'clock(3)'. _See also_: - *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::, - *note TIME8:: - + *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::, *note + TIME8:: File: gfortran.info, Node: MERGE, Next: MERGE_BITS, Prev: MCLOCK8, Up: Intrinsic Procedures -9.186 `MERGE' -- Merge variables +9.193 'MERGE' -- Merge variables ================================ _Description_: Select values from two arrays according to a logical mask. The - result is equal to TSOURCE if MASK is `.TRUE.', or equal to - FSOURCE if it is `.FALSE.'. + result is equal to TSOURCE if MASK is '.TRUE.', or equal to FSOURCE + if it is '.FALSE.'. _Standard_: Fortran 95 and later @@ -13846,29 +15110,28 @@ _Class_: Elemental function _Syntax_: - `RESULT = MERGE(TSOURCE, FSOURCE, MASK)' + 'RESULT = MERGE(TSOURCE, FSOURCE, MASK)' _Arguments_: - TSOURCE May be of any type. - FSOURCE Shall be of the same type and type parameters - as TSOURCE. - MASK Shall be of type `LOGICAL'. + TSOURCE May be of any type. + FSOURCE Shall be of the same type and type parameters as + TSOURCE. + MASK Shall be of type 'LOGICAL'. _Return value_: The result is of the same type and type parameters as TSOURCE. - File: gfortran.info, Node: MERGE_BITS, Next: MIN, Prev: MERGE, Up: Intrinsic Procedures -9.187 `MERGE_BITS' -- Merge of bits under mask +9.194 'MERGE_BITS' -- Merge of bits under mask ============================================== _Description_: - `MERGE_BITS(I, J, MASK)' merges the bits of I and J as determined + 'MERGE_BITS(I, J, MASK)' merges the bits of I and J as determined by the mask. The i-th bit of the result is equal to the i-th bit - of I if the i-th bit of MASK is 1; it is equal to the i-th bit of - J otherwise. + of I if the i-th bit of MASK is 1; it is equal to the i-th bit of J + otherwise. _Standard_: Fortran 2008 and later @@ -13877,23 +15140,22 @@ _Class_: Elemental function _Syntax_: - `RESULT = MERGE_BITS(I, J, MASK)' + 'RESULT = MERGE_BITS(I, J, MASK)' _Arguments_: - I Shall be of type `INTEGER'. - J Shall be of type `INTEGER' and of the same - kind as I. - MASK Shall be of type `INTEGER' and of the same - kind as I. + I Shall be of type 'INTEGER'. + J Shall be of type 'INTEGER' and of the same kind + as I. + MASK Shall be of type 'INTEGER' and of the same kind + as I. _Return value_: The result is of the same type and kind as I. - File: gfortran.info, Node: MIN, Next: MINEXPONENT, Prev: MERGE_BITS, Up: Intrinsic Procedures -9.188 `MIN' -- Minimum value of an argument list +9.195 'MIN' -- Minimum value of an argument list ================================================ _Description_: @@ -13906,30 +15168,30 @@ _Class_: Elemental function _Syntax_: - `RESULT = MIN(A1, A2 [, A3, ...])' + 'RESULT = MIN(A1, A2 [, A3, ...])' _Arguments_: - A1 The type shall be `INTEGER' or `REAL'. - A2, A3, An expression of the same type and kind as A1. - ... (As a GNU extension, arguments of different - kinds are permitted.) + A1 The type shall be 'INTEGER' or 'REAL'. + A2, A3, An expression of the same type and kind as A1. + ... (As a GNU extension, arguments of different + kinds are permitted.) _Return value_: The return value corresponds to the maximum value among the arguments, and has the same type and kind as the first argument. _Specific names_: - Name Argument Return type Standard - `MIN0(A1)' `INTEGER(4) `INTEGER(4)' Fortran 77 and - A1' later - `AMIN0(A1)' `INTEGER(4) `REAL(4)' Fortran 77 and - A1' later - `MIN1(A1)' `REAL A1' `INTEGER(4)' Fortran 77 and - later - `AMIN1(A1)' `REAL(4) A1' `REAL(4)' Fortran 77 and - later - `DMIN1(A1)' `REAL(8) A1' `REAL(8)' Fortran 77 and - later + Name Argument Return type Standard + 'MIN0(A1)' 'INTEGER(4) 'INTEGER(4)' Fortran 77 and + A1' later + 'AMIN0(A1)' 'INTEGER(4) 'REAL(4)' Fortran 77 and + A1' later + 'MIN1(A1)' 'REAL A1' 'INTEGER(4)' Fortran 77 and + later + 'AMIN1(A1)' 'REAL(4) A1' 'REAL(4)' Fortran 77 and + later + 'DMIN1(A1)' 'REAL(8) A1' 'REAL(8)' Fortran 77 and + later _See also_: *note MAX::, *note MINLOC::, *note MINVAL:: @@ -13937,12 +15199,12 @@ _See also_: File: gfortran.info, Node: MINEXPONENT, Next: MINLOC, Prev: MIN, Up: Intrinsic Procedures -9.189 `MINEXPONENT' -- Minimum exponent of a real kind +9.196 'MINEXPONENT' -- Minimum exponent of a real kind ====================================================== _Description_: - `MINEXPONENT(X)' returns the minimum exponent in the model of the - type of `X'. + 'MINEXPONENT(X)' returns the minimum exponent in the model of the + type of 'X'. _Standard_: Fortran 95 and later @@ -13951,22 +15213,22 @@ _Class_: Inquiry function _Syntax_: - `RESULT = MINEXPONENT(X)' + 'RESULT = MINEXPONENT(X)' _Arguments_: - X Shall be of type `REAL'. + X Shall be of type 'REAL'. _Return value_: - The return value is of type `INTEGER' and of the default integer + The return value is of type 'INTEGER' and of the default integer kind. _Example_: - See `MAXEXPONENT' for an example. + See 'MAXEXPONENT' for an example. File: gfortran.info, Node: MINLOC, Next: MINVAL, Prev: MINEXPONENT, Up: Intrinsic Procedures -9.190 `MINLOC' -- Location of the minimum value within an array +9.197 'MINLOC' -- Location of the minimum value within an array =============================================================== _Description_: @@ -13974,13 +15236,13 @@ _Description_: minimum value, or, if the DIM argument is supplied, determines the locations of the minimum element along each row of the array in the DIM direction. If MASK is present, only the elements for which - MASK is `.TRUE.' are considered. If more than one element in the + MASK is '.TRUE.' are considered. If more than one element in the array has the minimum value, the location returned is that of the first such element in array element order. If the array has zero - size, or all of the elements of MASK are `.FALSE.', then the - result is an array of zeroes. Similarly, if DIM is supplied and - all of the elements of MASK along a given row are zero, the result - value for that row is zero. + size, or all of the elements of MASK are '.FALSE.', then the result + is an array of zeroes. Similarly, if DIM is supplied and all of + the elements of MASK along a given row are zero, the result value + for that row is zero. _Standard_: Fortran 95 and later @@ -13989,17 +15251,17 @@ _Class_: Transformational function _Syntax_: - `RESULT = MINLOC(ARRAY, DIM [, MASK])' - `RESULT = MINLOC(ARRAY [, MASK])' + 'RESULT = MINLOC(ARRAY, DIM [, MASK])' + 'RESULT = MINLOC(ARRAY [, MASK])' _Arguments_: - ARRAY Shall be an array of type `INTEGER' or `REAL'. - DIM (Optional) Shall be a scalar of type - `INTEGER', with a value between one and the - rank of ARRAY, inclusive. It may not be an - optional dummy argument. - MASK Shall be an array of type `LOGICAL', and - conformable with ARRAY. + ARRAY Shall be an array of type 'INTEGER' or 'REAL'. + DIM (Optional) Shall be a scalar of type 'INTEGER', + with a value between one and the rank of ARRAY, + inclusive. It may not be an optional dummy + argument. + MASK Shall be an array of type 'LOGICAL', and + conformable with ARRAY. _Return value_: If DIM is absent, the result is a rank-one array with a length @@ -14007,27 +15269,25 @@ _Return value_: array with a rank one less than the rank of ARRAY, and a size corresponding to the size of ARRAY with the DIM dimension removed. If DIM is present and ARRAY has a rank of one, the result is a - scalar. In all cases, the result is of default `INTEGER' type. + scalar. In all cases, the result is of default 'INTEGER' type. _See also_: *note MIN::, *note MINVAL:: - File: gfortran.info, Node: MINVAL, Next: MOD, Prev: MINLOC, Up: Intrinsic Procedures -9.191 `MINVAL' -- Minimum value of an array +9.198 'MINVAL' -- Minimum value of an array =========================================== _Description_: - Determines the minimum value of the elements in an array value, - or, if the DIM argument is supplied, determines the minimum value - along each row of the array in the DIM direction. If MASK is - present, only the elements for which MASK is `.TRUE.' are - considered. If the array has zero size, or all of the elements of - MASK are `.FALSE.', then the result is `HUGE(ARRAY)' if ARRAY is - numeric, or a string of `CHAR(255)' characters if ARRAY is of - character type. + Determines the minimum value of the elements in an array value, or, + if the DIM argument is supplied, determines the minimum value along + each row of the array in the DIM direction. If MASK is present, + only the elements for which MASK is '.TRUE.' are considered. If + the array has zero size, or all of the elements of MASK are + '.FALSE.', then the result is 'HUGE(ARRAY)' if ARRAY is numeric, or + a string of 'CHAR(255)' characters if ARRAY is of character type. _Standard_: Fortran 95 and later @@ -14036,17 +15296,17 @@ _Class_: Transformational function _Syntax_: - `RESULT = MINVAL(ARRAY, DIM [, MASK])' - `RESULT = MINVAL(ARRAY [, MASK])' + 'RESULT = MINVAL(ARRAY, DIM [, MASK])' + 'RESULT = MINVAL(ARRAY [, MASK])' _Arguments_: - ARRAY Shall be an array of type `INTEGER' or `REAL'. - DIM (Optional) Shall be a scalar of type - `INTEGER', with a value between one and the - rank of ARRAY, inclusive. It may not be an - optional dummy argument. - MASK Shall be an array of type `LOGICAL', and - conformable with ARRAY. + ARRAY Shall be an array of type 'INTEGER' or 'REAL'. + DIM (Optional) Shall be a scalar of type 'INTEGER', + with a value between one and the rank of ARRAY, + inclusive. It may not be an optional dummy + argument. + MASK Shall be an array of type 'LOGICAL', and + conformable with ARRAY. _Return value_: If DIM is absent, or if ARRAY has a rank of one, the result is a @@ -14058,35 +15318,34 @@ _Return value_: _See also_: *note MIN::, *note MINLOC:: - File: gfortran.info, Node: MOD, Next: MODULO, Prev: MINVAL, Up: Intrinsic Procedures -9.192 `MOD' -- Remainder function +9.199 'MOD' -- Remainder function ================================= _Description_: - `MOD(A,P)' computes the remainder of the division of A by P. + 'MOD(A,P)' computes the remainder of the division of A by P. _Standard_: - Fortran 77 and later + Fortran 77 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = MOD(A, P)' + 'RESULT = MOD(A, P)' _Arguments_: - A Shall be a scalar of type `INTEGER' or `REAL'. - P Shall be a scalar of the same type and kind as - A and not equal to zero. + A Shall be a scalar of type 'INTEGER' or 'REAL'. + P Shall be a scalar of the same type and kind as A + and not equal to zero. _Return value_: - The return value is the result of `A - (INT(A/P) * P)'. The type + The return value is the result of 'A - (INT(A/P) * P)'. The type and kind of the return value is the same as that of the arguments. - The returned value has the same sign as A and a magnitude less - than the magnitude of P. + The returned value has the same sign as A and a magnitude less than + the magnitude of P. _Example_: program test_mod @@ -14107,26 +15366,33 @@ _Example_: end program test_mod _Specific names_: - Name Arguments Return type Standard - `MOD(A,P)' `INTEGER `INTEGER' Fortran 95 and - A,P' later - `AMOD(A,P)' `REAL(4) `REAL(4)' Fortran 95 and - A,P' later - `DMOD(A,P)' `REAL(8) `REAL(8)' Fortran 95 and - A,P' later + Name Arguments Return type Standard + 'MOD(A,P)' 'INTEGER 'INTEGER' Fortran 95 and + A,P' later + 'AMOD(A,P)' 'REAL(4) 'REAL(4)' Fortran 95 and + A,P' later + 'DMOD(A,P)' 'REAL(8) 'REAL(8)' Fortran 95 and + A,P' later + 'BMOD(A,P)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A,P' + 'IMOD(A,P)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A,P' + 'JMOD(A,P)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A,P' + 'KMOD(A,P)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A,P' _See also_: *note MODULO:: - File: gfortran.info, Node: MODULO, Next: MOVE_ALLOC, Prev: MOD, Up: Intrinsic Procedures -9.193 `MODULO' -- Modulo function +9.200 'MODULO' -- Modulo function ================================= _Description_: - `MODULO(A,P)' computes the A modulo P. + 'MODULO(A,P)' computes the A modulo P. _Standard_: Fortran 95 and later @@ -14135,21 +15401,20 @@ _Class_: Elemental function _Syntax_: - `RESULT = MODULO(A, P)' + 'RESULT = MODULO(A, P)' _Arguments_: - A Shall be a scalar of type `INTEGER' or `REAL'. - P Shall be a scalar of the same type and kind as - A. It shall not be zero. + A Shall be a scalar of type 'INTEGER' or 'REAL'. + P Shall be a scalar of the same type and kind as + A. It shall not be zero. _Return value_: The type and kind of the result are those of the arguments. - If A and P are of type `INTEGER': - `MODULO(A,P)' has the value R such that `A=Q*P+R', where Q is + If A and P are of type 'INTEGER': + 'MODULO(A,P)' has the value R such that 'A=Q*P+R', where Q is an integer and R is between 0 (inclusive) and P (exclusive). - - If A and P are of type `REAL': - `MODULO(A,P)' has the value of `A - FLOOR (A / P) * P'. + If A and P are of type 'REAL': + 'MODULO(A,P)' has the value of 'A - FLOOR (A / P) * P'. The returned value has the same sign as P and a magnitude less than the magnitude of P. @@ -14168,15 +15433,14 @@ _Example_: _See also_: *note MOD:: - File: gfortran.info, Node: MOVE_ALLOC, Next: MVBITS, Prev: MODULO, Up: Intrinsic Procedures -9.194 `MOVE_ALLOC' -- Move allocation from one object to another +9.201 'MOVE_ALLOC' -- Move allocation from one object to another ================================================================ _Description_: - `MOVE_ALLOC(FROM, TO)' moves the allocation from FROM to TO. FROM + 'MOVE_ALLOC(FROM, TO)' moves the allocation from FROM to TO. FROM will become deallocated in the process. _Standard_: @@ -14186,13 +15450,13 @@ _Class_: Pure subroutine _Syntax_: - `CALL MOVE_ALLOC(FROM, TO)' + 'CALL MOVE_ALLOC(FROM, TO)' _Arguments_: - FROM `ALLOCATABLE', `INTENT(INOUT)', may be of any - type and kind. - TO `ALLOCATABLE', `INTENT(OUT)', shall be of the - same type, kind and rank as FROM. + FROM 'ALLOCATABLE', 'INTENT(INOUT)', may be of any + type and kind. + TO 'ALLOCATABLE', 'INTENT(OUT)', shall be of the + same type, kind and rank as FROM. _Return value_: None @@ -14211,32 +15475,45 @@ _Example_: File: gfortran.info, Node: MVBITS, Next: NEAREST, Prev: MOVE_ALLOC, Up: Intrinsic Procedures -9.195 `MVBITS' -- Move bits from one integer to another +9.202 'MVBITS' -- Move bits from one integer to another ======================================================= _Description_: - Moves LEN bits from positions FROMPOS through `FROMPOS+LEN-1' of - FROM to positions TOPOS through `TOPOS+LEN-1' of TO. The portion + Moves LEN bits from positions FROMPOS through 'FROMPOS+LEN-1' of + FROM to positions TOPOS through 'TOPOS+LEN-1' of TO. The portion of argument TO not affected by the movement of bits is unchanged. - The values of `FROMPOS+LEN-1' and `TOPOS+LEN-1' must be less than - `BIT_SIZE(FROM)'. + The values of 'FROMPOS+LEN-1' and 'TOPOS+LEN-1' must be less than + 'BIT_SIZE(FROM)'. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental subroutine _Syntax_: - `CALL MVBITS(FROM, FROMPOS, LEN, TO, TOPOS)' + 'CALL MVBITS(FROM, FROMPOS, LEN, TO, TOPOS)' _Arguments_: - FROM The type shall be `INTEGER'. - FROMPOS The type shall be `INTEGER'. - LEN The type shall be `INTEGER'. - TO The type shall be `INTEGER', of the same kind - as FROM. - TOPOS The type shall be `INTEGER'. + FROM The type shall be 'INTEGER'. + FROMPOS The type shall be 'INTEGER'. + LEN The type shall be 'INTEGER'. + TO The type shall be 'INTEGER', of the same kind as + FROM. + TOPOS The type shall be 'INTEGER'. + +_Specific names_: + Name Argument Return type Standard + 'MVBITS(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BMVBITS(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'IMVBITS(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JMVBITS(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KMVBITS(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' _See also_: *note IBCLR::, *note IBSET::, *note IBITS::, *note IAND::, *note @@ -14245,12 +15522,12 @@ _See also_: File: gfortran.info, Node: NEAREST, Next: NEW_LINE, Prev: MVBITS, Up: Intrinsic Procedures -9.196 `NEAREST' -- Nearest representable number +9.203 'NEAREST' -- Nearest representable number =============================================== _Description_: - `NEAREST(X, S)' returns the processor-representable number nearest - to `X' in the direction indicated by the sign of `S'. + 'NEAREST(X, S)' returns the processor-representable number nearest + to 'X' in the direction indicated by the sign of 'S'. _Standard_: Fortran 95 and later @@ -14259,17 +15536,17 @@ _Class_: Elemental function _Syntax_: - `RESULT = NEAREST(X, S)' + 'RESULT = NEAREST(X, S)' _Arguments_: - X Shall be of type `REAL'. - S Shall be of type `REAL' and not equal to zero. + X Shall be of type 'REAL'. + S Shall be of type 'REAL' and not equal to zero. _Return value_: - The return value is of the same type as `X'. If `S' is positive, - `NEAREST' returns the processor-representable number greater than - `X' and nearest to it. If `S' is negative, `NEAREST' returns the - processor-representable number smaller than `X' and nearest to it. + The return value is of the same type as 'X'. If 'S' is positive, + 'NEAREST' returns the processor-representable number greater than + 'X' and nearest to it. If 'S' is negative, 'NEAREST' returns the + processor-representable number smaller than 'X' and nearest to it. _Example_: program test_nearest @@ -14282,11 +15559,11 @@ _Example_: File: gfortran.info, Node: NEW_LINE, Next: NINT, Prev: NEAREST, Up: Intrinsic Procedures -9.197 `NEW_LINE' -- New line character +9.204 'NEW_LINE' -- New line character ====================================== _Description_: - `NEW_LINE(C)' returns the new-line character. + 'NEW_LINE(C)' returns the new-line character. _Standard_: Fortran 2003 and later @@ -14295,11 +15572,11 @@ _Class_: Inquiry function _Syntax_: - `RESULT = NEW_LINE(C)' + 'RESULT = NEW_LINE(C)' _Arguments_: - C The argument shall be a scalar or array of the - type `CHARACTER'. + C The argument shall be a scalar or array of the + type 'CHARACTER'. _Return value_: Returns a CHARACTER scalar of length one with the new-line @@ -14314,11 +15591,11 @@ _Example_: File: gfortran.info, Node: NINT, Next: NORM2, Prev: NEW_LINE, Up: Intrinsic Procedures -9.198 `NINT' -- Nearest whole number +9.205 'NINT' -- Nearest whole number ==================================== _Description_: - `NINT(A)' rounds its argument to the nearest whole number. + 'NINT(A)' rounds its argument to the nearest whole number. _Standard_: Fortran 77 and later, with KIND argument Fortran 90 and later @@ -14327,18 +15604,18 @@ _Class_: Elemental function _Syntax_: - `RESULT = NINT(A [, KIND])' + 'RESULT = NINT(A [, KIND])' _Arguments_: - A The type of the argument shall be `REAL'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + A The type of the argument shall be 'REAL'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: Returns A with the fractional portion of its magnitude eliminated by rounding to the nearest whole number and with its sign - preserved, converted to an `INTEGER' of the default kind. + preserved, converted to an 'INTEGER' of the default kind. _Example_: program test_nint @@ -14350,20 +15627,19 @@ _Example_: end program test_nint _Specific names_: - Name Argument Return Type Standard - `NINT(A)' `REAL(4) A' `INTEGER' Fortran 95 and - later - `IDNINT(A)' `REAL(8) A' `INTEGER' Fortran 95 and - later + Name Argument Return Type Standard + 'NINT(A)' 'REAL(4) A' 'INTEGER' Fortran 95 and + later + 'IDNINT(A)' 'REAL(8) A' 'INTEGER' Fortran 95 and + later _See also_: *note CEILING::, *note FLOOR:: - File: gfortran.info, Node: NORM2, Next: NOT, Prev: NINT, Up: Intrinsic Procedures -9.199 `NORM2' -- Euclidean vector norms +9.206 'NORM2' -- Euclidean vector norms ======================================= _Description_: @@ -14377,21 +15653,21 @@ _Class_: Transformational function _Syntax_: - `RESULT = NORM2(ARRAY[, DIM])' + 'RESULT = NORM2(ARRAY[, DIM])' _Arguments_: - ARRAY Shall be an array of type `REAL' - DIM (Optional) shall be a scalar of type `INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. + ARRAY Shall be an array of type 'REAL' + DIM (Optional) shall be a scalar of type 'INTEGER' + with a value in the range from 1 to n, where n + equals the rank of ARRAY. _Return value_: The result is of the same type as ARRAY. If DIM is absent, a scalar with the square root of the sum of all - elements in ARRAY squared is returned. Otherwise, an array of - rank n-1, where n equals the rank of ARRAY, and a shape similar to - that of ARRAY with dimension DIM dropped is returned. + elements in ARRAY squared is returned. Otherwise, an array of rank + n-1, where n equals the rank of ARRAY, and a shape similar to that + of ARRAY with dimension DIM dropped is returned. _Example_: PROGRAM test_sum @@ -14402,36 +15678,48 @@ _Example_: File: gfortran.info, Node: NOT, Next: NULL, Prev: NORM2, Up: Intrinsic Procedures -9.200 `NOT' -- Logical negation +9.207 'NOT' -- Logical negation =============================== _Description_: - `NOT' returns the bitwise Boolean inverse of I. + 'NOT' returns the bitwise Boolean inverse of I. _Standard_: - Fortran 95 and later + Fortran 95 and later, has overloads that are GNU extensions _Class_: Elemental function _Syntax_: - `RESULT = NOT(I)' + 'RESULT = NOT(I)' _Arguments_: - I The type shall be `INTEGER'. + I The type shall be 'INTEGER'. _Return value_: - The return type is `INTEGER', of the same kind as the argument. + The return type is 'INTEGER', of the same kind as the argument. + +_Specific names_: + Name Argument Return type Standard + 'NOT(A)' 'INTEGER A' 'INTEGER' Fortran 95 and + later + 'BNOT(A)' 'INTEGER(1) 'INTEGER(1)' GNU extension + A' + 'INOT(A)' 'INTEGER(2) 'INTEGER(2)' GNU extension + A' + 'JNOT(A)' 'INTEGER(4) 'INTEGER(4)' GNU extension + A' + 'KNOT(A)' 'INTEGER(8) 'INTEGER(8)' GNU extension + A' _See also_: *note IAND::, *note IEOR::, *note IOR::, *note IBITS::, *note IBSET::, *note IBCLR:: - File: gfortran.info, Node: NULL, Next: NUM_IMAGES, Prev: NOT, Up: Intrinsic Procedures -9.201 `NULL' -- Function that returns an disassociated pointer +9.208 'NULL' -- Function that returns an disassociated pointer ============================================================== _Description_: @@ -14440,7 +15728,7 @@ _Description_: If MOLD is present, a disassociated pointer of the same type is returned, otherwise the type is determined by context. - In Fortran 95, MOLD is optional. Please note that Fortran 2003 + In Fortran 95, MOLD is optional. Please note that Fortran 2003 includes cases where it is required. _Standard_: @@ -14450,11 +15738,11 @@ _Class_: Transformational function _Syntax_: - `PTR => NULL([MOLD])' + 'PTR => NULL([MOLD])' _Arguments_: - MOLD (Optional) shall be a pointer of any - association status and of any type. + MOLD (Optional) shall be a pointer of any association + status and of any type. _Return value_: A disassociated pointer. @@ -14468,37 +15756,36 @@ _See also_: File: gfortran.info, Node: NUM_IMAGES, Next: OR, Prev: NULL, Up: Intrinsic Procedures -9.202 `NUM_IMAGES' -- Function that returns the number of images +9.209 'NUM_IMAGES' -- Function that returns the number of images ================================================================ _Description_: Returns the number of images. _Standard_: - Fortran 2008 and later. With DISTANCE or FAILED argument, + Fortran 2008 and later. With DISTANCE or FAILED argument, Technical Specification (TS) 18508 or later _Class_: Transformational function _Syntax_: - `RESULT = NUM_IMAGES(DISTANCE, FAILED)' + 'RESULT = NUM_IMAGES(DISTANCE, FAILED)' _Arguments_: - DISTANCE (optional, intent(in)) Nonnegative scalar - integer - FAILED (optional, intent(in)) Scalar logical - expression + DISTANCE (optional, intent(in)) Nonnegative scalar + integer + FAILED (optional, intent(in)) Scalar logical expression _Return value_: Scalar default-kind integer. If DISTANCE is not present or has - value 0, the number of images in the current team is returned. For + value 0, the number of images in the current team is returned. For values smaller or equal distance to the initial team, it returns the number of images index on the ancestor team which has a - distance of DISTANCE from the invoking team. If DISTANCE is larger + distance of DISTANCE from the invoking team. If DISTANCE is larger than the distance to the initial team, the number of images of the - initial team is returned. If FAILED is not present the total - number of images is returned; if it has the value `.TRUE.', the + initial team is returned. If FAILED is not present the total + number of images is returned; if it has the value '.TRUE.', the number of failed images is returned, otherwise, the number of images which do have not the failed status. @@ -14519,11 +15806,11 @@ _See also_: File: gfortran.info, Node: OR, Next: PACK, Prev: NUM_IMAGES, Up: Intrinsic Procedures -9.203 `OR' -- Bitwise logical OR +9.210 'OR' -- Bitwise logical OR ================================ _Description_: - Bitwise logical `OR'. + Bitwise logical 'OR'. This intrinsic routine is provided for backwards compatibility with GNU Fortran 77. For integer arguments, programmers should consider @@ -14537,18 +15824,18 @@ _Class_: Function _Syntax_: - `RESULT = OR(I, J)' + 'RESULT = OR(I, J)' _Arguments_: - I The type shall be either a scalar `INTEGER' - type or a scalar `LOGICAL' type. - J The type shall be the same as the type of J. + I The type shall be either a scalar 'INTEGER' type + or a scalar 'LOGICAL' type. + J The type shall be the same as the type of J. _Return value_: - The return type is either a scalar `INTEGER' or a scalar - `LOGICAL'. If the kind type parameters differ, then the smaller - kind type is implicitly converted to larger kind, and the return - has the larger kind. + The return type is either a scalar 'INTEGER' or a scalar 'LOGICAL'. + If the kind type parameters differ, then the smaller kind type is + implicitly converted to larger kind, and the return has the larger + kind. _Example_: PROGRAM test_or @@ -14566,14 +15853,14 @@ _See also_: File: gfortran.info, Node: PACK, Next: PARITY, Prev: OR, Up: Intrinsic Procedures -9.204 `PACK' -- Pack an array into an array of rank one +9.211 'PACK' -- Pack an array into an array of rank one ======================================================= _Description_: Stores the elements of ARRAY in an array of rank one. The beginning of the resulting array is made up of elements whose - MASK equals `TRUE'. Afterwards, positions are filled with elements + MASK equals 'TRUE'. Afterwards, positions are filled with elements taken from VECTOR. _Standard_: @@ -14583,25 +15870,25 @@ _Class_: Transformational function _Syntax_: - `RESULT = PACK(ARRAY, MASK[,VECTOR])' + 'RESULT = PACK(ARRAY, MASK[,VECTOR])' _Arguments_: - ARRAY Shall be an array of any type. - MASK Shall be an array of type `LOGICAL' and of the - same size as ARRAY. Alternatively, it may be a - `LOGICAL' scalar. - VECTOR (Optional) shall be an array of the same type - as ARRAY and of rank one. If present, the - number of elements in VECTOR shall be equal to - or greater than the number of true elements in - MASK. If MASK is scalar, the number of - elements in VECTOR shall be equal to or - greater than the number of elements in ARRAY. + ARRAY Shall be an array of any type. + MASK Shall be an array of type 'LOGICAL' and of the + same size as ARRAY. Alternatively, it may be a + 'LOGICAL' scalar. + VECTOR (Optional) shall be an array of the same type as + ARRAY and of rank one. If present, the number + of elements in VECTOR shall be equal to or + greater than the number of true elements in + MASK. If MASK is scalar, the number of elements + in VECTOR shall be equal to or greater than the + number of elements in ARRAY. _Return value_: The result is an array of rank one and the same type as that of ARRAY. If VECTOR is present, the result size is that of VECTOR, - the number of `TRUE' values in MASK otherwise. + the number of 'TRUE' values in MASK otherwise. _Example_: Gathering nonzero elements from an array: @@ -14625,11 +15912,11 @@ _See also_: File: gfortran.info, Node: PARITY, Next: PERROR, Prev: PACK, Up: Intrinsic Procedures -9.205 `PARITY' -- Reduction with exclusive OR +9.212 'PARITY' -- Reduction with exclusive OR ============================================= _Description_: - Calculates the parity, i.e. the reduction using `.XOR.', of MASK + Calculates the parity, i.e. the reduction using '.XOR.', of MASK along dimension DIM. _Standard_: @@ -14639,19 +15926,19 @@ _Class_: Transformational function _Syntax_: - `RESULT = PARITY(MASK[, DIM])' + 'RESULT = PARITY(MASK[, DIM])' _Arguments_: - LOGICAL Shall be an array of type `LOGICAL' - DIM (Optional) shall be a scalar of type `INTEGER' - with a value in the range from 1 to n, where n - equals the rank of MASK. + LOGICAL Shall be an array of type 'LOGICAL' + DIM (Optional) shall be a scalar of type 'INTEGER' + with a value in the range from 1 to n, where n + equals the rank of MASK. _Return value_: The result is of the same type as MASK. If DIM is absent, a scalar with the parity of all elements in MASK - is returned, i.e. true if an odd number of elements is `.true.' + is returned, i.e. true if an odd number of elements is '.true.' and false otherwise. If DIM is present, an array of rank n-1, where n equals the rank of ARRAY, and a shape similar to that of MASK with dimension DIM dropped is returned. @@ -14665,13 +15952,13 @@ _Example_: File: gfortran.info, Node: PERROR, Next: POPCNT, Prev: PARITY, Up: Intrinsic Procedures -9.206 `PERROR' -- Print system error message +9.213 'PERROR' -- Print system error message ============================================ _Description_: - Prints (on the C `stderr' stream) a newline-terminated error - message corresponding to the last system error. This is prefixed by - STRING, a colon and a space. See `perror(3)'. + Prints (on the C 'stderr' stream) a newline-terminated error + message corresponding to the last system error. This is prefixed + by STRING, a colon and a space. See 'perror(3)'. _Standard_: GNU extension @@ -14680,11 +15967,11 @@ _Class_: Subroutine _Syntax_: - `CALL PERROR(STRING)' + 'CALL PERROR(STRING)' _Arguments_: - STRING A scalar of type `CHARACTER' and of the - default kind. + STRING A scalar of type 'CHARACTER' and of the default + kind. _See also_: *note IERRNO:: @@ -14692,12 +15979,12 @@ _See also_: File: gfortran.info, Node: POPCNT, Next: POPPAR, Prev: PERROR, Up: Intrinsic Procedures -9.207 `POPCNT' -- Number of bits set +9.214 'POPCNT' -- Number of bits set ==================================== _Description_: - `POPCNT(I)' returns the number of bits set ('1' bits) in the binary - representation of `I'. + 'POPCNT(I)' returns the number of bits set ('1' bits) in the binary + representation of 'I'. _Standard_: Fortran 2008 and later @@ -14706,13 +15993,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = POPCNT(I)' + 'RESULT = POPCNT(I)' _Arguments_: - I Shall be of type `INTEGER'. + I Shall be of type 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the default integer + The return value is of type 'INTEGER' and of the default integer kind. _See also_: @@ -14728,13 +16015,13 @@ _Example_: File: gfortran.info, Node: POPPAR, Next: PRECISION, Prev: POPCNT, Up: Intrinsic Procedures -9.208 `POPPAR' -- Parity of the number of bits set +9.215 'POPPAR' -- Parity of the number of bits set ================================================== _Description_: - `POPPAR(I)' returns parity of the integer `I', i.e. the parity of + 'POPPAR(I)' returns parity of the integer 'I', i.e. the parity of the number of bits set ('1' bits) in the binary representation of - `I'. It is equal to 0 if `I' has an even number of bits set, and 1 + 'I'. It is equal to 0 if 'I' has an even number of bits set, and 1 for an odd number of '1' bits. _Standard_: @@ -14744,13 +16031,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = POPPAR(I)' + 'RESULT = POPPAR(I)' _Arguments_: - I Shall be of type `INTEGER'. + I Shall be of type 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the default integer + The return value is of type 'INTEGER' and of the default integer kind. _See also_: @@ -14766,12 +16053,12 @@ _Example_: File: gfortran.info, Node: PRECISION, Next: PRESENT, Prev: POPPAR, Up: Intrinsic Procedures -9.209 `PRECISION' -- Decimal precision of a real kind +9.216 'PRECISION' -- Decimal precision of a real kind ===================================================== _Description_: - `PRECISION(X)' returns the decimal precision in the model of the - type of `X'. + 'PRECISION(X)' returns the decimal precision in the model of the + type of 'X'. _Standard_: Fortran 95 and later @@ -14780,13 +16067,13 @@ _Class_: Inquiry function _Syntax_: - `RESULT = PRECISION(X)' + 'RESULT = PRECISION(X)' _Arguments_: - X Shall be of type `REAL' or `COMPLEX'. + X Shall be of type 'REAL' or 'COMPLEX'. _Return value_: - The return value is of type `INTEGER' and of the default integer + The return value is of type 'INTEGER' and of the default integer kind. _See also_: @@ -14804,7 +16091,7 @@ _Example_: File: gfortran.info, Node: PRESENT, Next: PRODUCT, Prev: PRECISION, Up: Intrinsic Procedures -9.210 `PRESENT' -- Determine whether an optional dummy argument is specified +9.217 'PRESENT' -- Determine whether an optional dummy argument is specified ============================================================================ _Description_: @@ -14817,18 +16104,18 @@ _Class_: Inquiry function _Syntax_: - `RESULT = PRESENT(A)' + 'RESULT = PRESENT(A)' _Arguments_: - A May be of any type and may be a pointer, - scalar or array value, or a dummy procedure. - It shall be the name of an optional dummy - argument accessible within the current - subroutine or function. + A May be of any type and may be a pointer, scalar + or array value, or a dummy procedure. It shall + be the name of an optional dummy argument + accessible within the current subroutine or + function. _Return value_: - Returns either `TRUE' if the optional argument A is present, or - `FALSE' otherwise. + Returns either 'TRUE' if the optional argument A is present, or + 'FALSE' otherwise. _Example_: PROGRAM test_present @@ -14843,12 +16130,12 @@ _Example_: File: gfortran.info, Node: PRODUCT, Next: RADIX, Prev: PRESENT, Up: Intrinsic Procedures -9.211 `PRODUCT' -- Product of array elements +9.218 'PRODUCT' -- Product of array elements ============================================ _Description_: Multiplies the elements of ARRAY along dimension DIM if the - corresponding element in MASK is `TRUE'. + corresponding element in MASK is 'TRUE'. _Standard_: Fortran 95 and later @@ -14857,24 +16144,24 @@ _Class_: Transformational function _Syntax_: - `RESULT = PRODUCT(ARRAY[, MASK])' - `RESULT = PRODUCT(ARRAY, DIM[, MASK])' + 'RESULT = PRODUCT(ARRAY[, MASK])' + 'RESULT = PRODUCT(ARRAY, DIM[, MASK])' _Arguments_: - ARRAY Shall be an array of type `INTEGER', `REAL' or - `COMPLEX'. - DIM (Optional) shall be a scalar of type `INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type `LOGICAL' and - either be a scalar or an array of the same - shape as ARRAY. + ARRAY Shall be an array of type 'INTEGER', 'REAL' or + 'COMPLEX'. + DIM (Optional) shall be a scalar of type 'INTEGER' + with a value in the range from 1 to n, where n + equals the rank of ARRAY. + MASK (Optional) shall be of type 'LOGICAL' and either + be a scalar or an array of the same shape as + ARRAY. _Return value_: The result is of the same type as ARRAY. If DIM is absent, a scalar with the product of all elements in - ARRAY is returned. Otherwise, an array of rank n-1, where n equals + ARRAY is returned. Otherwise, an array of rank n-1, where n equals the rank of ARRAY, and a shape similar to that of ARRAY with dimension DIM dropped is returned. @@ -14891,11 +16178,11 @@ _See also_: File: gfortran.info, Node: RADIX, Next: RAN, Prev: PRODUCT, Up: Intrinsic Procedures -9.212 `RADIX' -- Base of a model number +9.219 'RADIX' -- Base of a model number ======================================= _Description_: - `RADIX(X)' returns the base of the model representing the entity X. + 'RADIX(X)' returns the base of the model representing the entity X. _Standard_: Fortran 95 and later @@ -14904,13 +16191,13 @@ _Class_: Inquiry function _Syntax_: - `RESULT = RADIX(X)' + 'RESULT = RADIX(X)' _Arguments_: - X Shall be of type `INTEGER' or `REAL' + X Shall be of type 'INTEGER' or 'REAL' _Return value_: - The return value is a scalar of type `INTEGER' and of the default + The return value is a scalar of type 'INTEGER' and of the default integer kind. _See also_: @@ -14922,16 +16209,15 @@ _Example_: print *, "The radix for the default real kind is", radix(0.0) end program test_radix - File: gfortran.info, Node: RAN, Next: RAND, Prev: RADIX, Up: Intrinsic Procedures -9.213 `RAN' -- Real pseudo-random number +9.220 'RAN' -- Real pseudo-random number ======================================== _Description_: - For compatibility with HP FORTRAN 77/iX, the `RAN' intrinsic is - provided as an alias for `RAND'. See *note RAND:: for complete + For compatibility with HP FORTRAN 77/iX, the 'RAN' intrinsic is + provided as an alias for 'RAND'. See *note RAND:: for complete documentation. _Standard_: @@ -14946,20 +16232,20 @@ _See also_: File: gfortran.info, Node: RAND, Next: RANDOM_NUMBER, Prev: RAN, Up: Intrinsic Procedures -9.214 `RAND' -- Real pseudo-random number +9.221 'RAND' -- Real pseudo-random number ========================================= _Description_: - `RAND(FLAG)' returns a pseudo-random number from a uniform - distribution between 0 and 1. If FLAG is 0, the next number in the + 'RAND(FLAG)' returns a pseudo-random number from a uniform + distribution between 0 and 1. If FLAG is 0, the next number in the current sequence is returned; if FLAG is 1, the generator is - restarted by `CALL SRAND(0)'; if FLAG has any other value, it is - used as a new seed with `SRAND'. + restarted by 'CALL SRAND(0)'; if FLAG has any other value, it is + used as a new seed with 'SRAND'. This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. It implements a simple modulo generator as provided - by `g77'. For new code, one should consider the use of *note - RANDOM_NUMBER:: as it implements a superior algorithm. + GNU Fortran 77. It implements a simple modulo generator as + provided by 'g77'. For new code, one should consider the use of + *note RANDOM_NUMBER:: as it implements a superior algorithm. _Standard_: GNU extension @@ -14968,13 +16254,13 @@ _Class_: Function _Syntax_: - `RESULT = RAND(I)' + 'RESULT = RAND(I)' _Arguments_: - I Shall be a scalar `INTEGER' of kind 4. + I Shall be a scalar 'INTEGER' of kind 4. _Return value_: - The return value is of `REAL' type and the default kind. + The return value is of 'REAL' type and the default kind. _Example_: program test_rand @@ -14988,35 +16274,25 @@ _Example_: _See also_: *note SRAND::, *note RANDOM_NUMBER:: - File: gfortran.info, Node: RANDOM_NUMBER, Next: RANDOM_SEED, Prev: RAND, Up: Intrinsic Procedures -9.215 `RANDOM_NUMBER' -- Pseudo-random number +9.222 'RANDOM_NUMBER' -- Pseudo-random number ============================================= _Description_: Returns a single pseudorandom number or an array of pseudorandom - numbers from the uniform distribution over the range 0 \leq x < 1. + numbers from the uniform distribution over the range 0 \leq x < 1. - The runtime-library implements George Marsaglia's KISS (Keep It - Simple Stupid) random number generator (RNG). This RNG combines: - 1. The congruential generator x(n) = 69069 \cdot x(n-1) + - 1327217885 with a period of 2^32, + The runtime-library implements the xorshift1024* random number + generator (RNG). This generator has a period of 2^{1024} - 1, and + when using multiple threads up to 2^{512} threads can each generate + 2^{512} random numbers before any aliasing occurs. - 2. A 3-shift shift-register generator with a period of 2^32 - 1, - - 3. Two 16-bit multiply-with-carry generators with a period of - 597273182964842497 > 2^59. - The overall period exceeds 2^123. - - Please note, this RNG is thread safe if used within OpenMP - directives, i.e., its state will be consistent while called from - multiple threads. However, the KISS generator does not create - random numbers in parallel from multiple sources, but in sequence - from a single source. If an OpenMP-enabled application heavily - relies on random numbers, one should consider employing a - dedicated parallel random number generator instead. + Note that in a multi-threaded program (e.g. using OpenMP + directives), each thread will have its own random number state. + For details of the seeding procedure, see the documentation for the + 'RANDOM_SEED' intrinsic. _Standard_: Fortran 95 and later @@ -15025,15 +16301,14 @@ _Class_: Subroutine _Syntax_: - `RANDOM_NUMBER(HARVEST)' + 'RANDOM_NUMBER(HARVEST)' _Arguments_: - HARVEST Shall be a scalar or an array of type `REAL'. + HARVEST Shall be a scalar or an array of type 'REAL'. _Example_: program test_random_number REAL :: r(5,5) - CALL init_random_seed() ! see example of RANDOM_SEED CALL RANDOM_NUMBER(r) end program @@ -15043,19 +16318,27 @@ _See also_: File: gfortran.info, Node: RANDOM_SEED, Next: RANGE, Prev: RANDOM_NUMBER, Up: Intrinsic Procedures -9.216 `RANDOM_SEED' -- Initialize a pseudo-random number sequence +9.223 'RANDOM_SEED' -- Initialize a pseudo-random number sequence ================================================================= _Description_: Restarts or queries the state of the pseudorandom number generator - used by `RANDOM_NUMBER'. + used by 'RANDOM_NUMBER'. + + If 'RANDOM_SEED' is called without arguments, it is seeded with + random data retrieved from the operating system. - If `RANDOM_SEED' is called without arguments, it is initialized to - a default state. The example below shows how to initialize the - random seed with a varying seed in order to ensure a different - random number sequence for each invocation of the program. Note - that setting any of the seed values to zero should be avoided as - it can result in poor quality random numbers being generated. + As an extension to the Fortran standard, the GFortran + 'RANDOM_NUMBER' supports multiple threads. Each thread in a + multi-threaded program has its own seed. When 'RANDOM_SEED' is + called either without arguments or with the PUT argument, the given + seed is copied into a master seed as well as the seed of the + current thread. When a new thread uses 'RANDOM_NUMBER' for the + first time, the seed is copied from the master seed, and forwarded + N * 2^{512} steps to guarantee that the random stream does not + alias any other stream in the system, where N is the number of + threads that have used 'RANDOM_NUMBER' so far during the program + execution. _Standard_: Fortran 95 and later @@ -15064,76 +16347,35 @@ _Class_: Subroutine _Syntax_: - `CALL RANDOM_SEED([SIZE, PUT, GET])' + 'CALL RANDOM_SEED([SIZE, PUT, GET])' _Arguments_: - SIZE (Optional) Shall be a scalar and of type - default `INTEGER', with `INTENT(OUT)'. It - specifies the minimum size of the arrays used - with the PUT and GET arguments. - PUT (Optional) Shall be an array of type default - `INTEGER' and rank one. It is `INTENT(IN)' and - the size of the array must be larger than or - equal to the number returned by the SIZE - argument. - GET (Optional) Shall be an array of type default - `INTEGER' and rank one. It is `INTENT(OUT)' - and the size of the array must be larger than - or equal to the number returned by the SIZE - argument. + SIZE (Optional) Shall be a scalar and of type default + 'INTEGER', with 'INTENT(OUT)'. It specifies the + minimum size of the arrays used with the PUT and + GET arguments. + PUT (Optional) Shall be an array of type default + 'INTEGER' and rank one. It is 'INTENT(IN)' and + the size of the array must be larger than or + equal to the number returned by the SIZE + argument. + GET (Optional) Shall be an array of type default + 'INTEGER' and rank one. It is 'INTENT(OUT)' and + the size of the array must be larger than or + equal to the number returned by the SIZE + argument. _Example_: - subroutine init_random_seed() - use iso_fortran_env, only: int64 + program test_random_seed implicit none integer, allocatable :: seed(:) - integer :: i, n, un, istat, dt(8), pid - integer(int64) :: t + integer :: n call random_seed(size = n) allocate(seed(n)) - ! First try if the OS provides a random number generator - open(newunit=un, file="/dev/urandom", access="stream", & - form="unformatted", action="read", status="old", iostat=istat) - if (istat == 0) then - read(un) seed - close(un) - else - ! Fallback to XOR:ing the current time and pid. The PID is - ! useful in case one launches multiple instances of the same - ! program in parallel. - call system_clock(t) - if (t == 0) then - call date_and_time(values=dt) - t = (dt(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 & - + dt(2) * 31_int64 * 24 * 60 * 60 * 1000 & - + dt(3) * 24_int64 * 60 * 60 * 1000 & - + dt(5) * 60 * 60 * 1000 & - + dt(6) * 60 * 1000 + dt(7) * 1000 & - + dt(8) - end if - pid = getpid() - t = ieor(t, int(pid, kind(t))) - do i = 1, n - seed(i) = lcg(t) - end do - end if - call random_seed(put=seed) - contains - ! This simple PRNG might not be good enough for real work, but is - ! sufficient for seeding a better PRNG. - function lcg(s) - integer :: lcg - integer(int64) :: s - if (s == 0) then - s = 104729 - else - s = mod(s, 4294967296_int64) - end if - s = mod(s * 279470273_int64, 4294967291_int64) - lcg = int(mod(s, int(huge(0), int64)), kind(0)) - end function lcg - end subroutine init_random_seed + call random_seed(get=seed) + write (*, *) seed + end program test_random_seed _See also_: *note RANDOM_NUMBER:: @@ -15141,12 +16383,12 @@ _See also_: File: gfortran.info, Node: RANGE, Next: RANK, Prev: RANDOM_SEED, Up: Intrinsic Procedures -9.217 `RANGE' -- Decimal exponent range +9.224 'RANGE' -- Decimal exponent range ======================================= _Description_: - `RANGE(X)' returns the decimal exponent range in the model of the - type of `X'. + 'RANGE(X)' returns the decimal exponent range in the model of the + type of 'X'. _Standard_: Fortran 95 and later @@ -15155,30 +16397,29 @@ _Class_: Inquiry function _Syntax_: - `RESULT = RANGE(X)' + 'RESULT = RANGE(X)' _Arguments_: - X Shall be of type `INTEGER', `REAL' or - `COMPLEX'. + X Shall be of type 'INTEGER', 'REAL' or 'COMPLEX'. _Return value_: - The return value is of type `INTEGER' and of the default integer + The return value is of type 'INTEGER' and of the default integer kind. _See also_: *note SELECTED_REAL_KIND::, *note PRECISION:: _Example_: - See `PRECISION' for an example. + See 'PRECISION' for an example. File: gfortran.info, Node: RANK, Next: REAL, Prev: RANGE, Up: Intrinsic Procedures -9.218 `RANK' -- Rank of a data object +9.225 'RANK' -- Rank of a data object ===================================== _Description_: - `RANK(A)' returns the rank of a scalar or array data object. + 'RANK(A)' returns the rank of a scalar or array data object. _Standard_: Technical Specification (TS) 29113 @@ -15187,14 +16428,14 @@ _Class_: Inquiry function _Syntax_: - `RESULT = RANK(A)' + 'RESULT = RANK(A)' _Arguments_: - A can be of any type + A can be of any type _Return value_: - The return value is of type `INTEGER' and of the default integer - kind. For arrays, their rank is returned; for scalars zero is + The return value is of type 'INTEGER' and of the default integer + kind. For arrays, their rank is returned; for scalars zero is returned. _Example_: @@ -15205,16 +16446,15 @@ _Example_: print *, rank(a), rank(b) ! Prints: 0 2 end program test_rank - File: gfortran.info, Node: REAL, Next: RENAME, Prev: RANK, Up: Intrinsic Procedures -9.219 `REAL' -- Convert to real type +9.226 'REAL' -- Convert to real type ==================================== _Description_: - `REAL(A [, KIND])' converts its argument A to a real type. The - `REALPART' function is provided for compatibility with `g77', and + 'REAL(A [, KIND])' converts its argument A to a real type. The + 'REALPART' function is provided for compatibility with 'g77', and its use is strongly discouraged. _Standard_: @@ -15224,29 +16464,27 @@ _Class_: Elemental function _Syntax_: - `RESULT = REAL(A [, KIND])' - `RESULT = REALPART(Z)' + 'RESULT = REAL(A [, KIND])' + 'RESULT = REALPART(Z)' _Arguments_: - A Shall be `INTEGER', `REAL', or `COMPLEX'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + A Shall be 'INTEGER', 'REAL', or 'COMPLEX'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - These functions return a `REAL' variable or array under the + These functions return a 'REAL' variable or array under the following rules: - (A) - `REAL(A)' is converted to a default real type if A is an + (A) + 'REAL(A)' is converted to a default real type if A is an integer or real variable. - - (B) - `REAL(A)' is converted to a real type with the kind type + (B) + 'REAL(A)' is converted to a real type with the kind type parameter of A if A is a complex variable. - - (C) - `REAL(A, KIND)' is converted to a real type with kind type + (C) + 'REAL(A, KIND)' is converted to a real type with kind type parameter KIND if A is a complex, integer, or real variable. _Example_: @@ -15256,29 +16494,31 @@ _Example_: end program test_real _Specific names_: - Name Argument Return type Standard - `FLOAT(A)' `INTEGER(4)' `REAL(4)' Fortran 77 and - later - `DFLOAT(A)' `INTEGER(4)' `REAL(8)' GNU extension - `SNGL(A)' `INTEGER(8)' `REAL(4)' Fortran 77 and - later + Name Argument Return type Standard + 'FLOAT(A)' 'INTEGER(4)' 'REAL(4)' Fortran 77 and + later + 'DFLOAT(A)' 'INTEGER(4)' 'REAL(8)' GNU extension + 'FLOATI(A)' 'INTEGER(2)' 'REAL(4)' GNU extension + 'FLOATJ(A)' 'INTEGER(4)' 'REAL(4)' GNU extension + 'FLOATK(A)' 'INTEGER(8)' 'REAL(4)' GNU extension + 'SNGL(A)' 'INTEGER(8)' 'REAL(4)' Fortran 77 and + later _See also_: *note DBLE:: - File: gfortran.info, Node: RENAME, Next: REPEAT, Prev: REAL, Up: Intrinsic Procedures -9.220 `RENAME' -- Rename a file +9.227 'RENAME' -- Rename a file =============================== _Description_: - Renames a file from file PATH1 to PATH2. A null character - (`CHAR(0)') can be used to mark the end of the names in PATH1 and + Renames a file from file PATH1 to PATH2. A null character + ('CHAR(0)') can be used to mark the end of the names in PATH1 and PATH2; otherwise, trailing blanks in the file names are ignored. If the STATUS argument is supplied, it contains 0 on success or a - nonzero error code upon return; see `rename(2)'. + nonzero error code upon return; see 'rename(2)'. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -15290,22 +16530,21 @@ _Class_: Subroutine, function _Syntax_: - `CALL RENAME(PATH1, PATH2 [, STATUS])' - `STATUS = RENAME(PATH1, PATH2)' + 'CALL RENAME(PATH1, PATH2 [, STATUS])' + 'STATUS = RENAME(PATH1, PATH2)' _Arguments_: - PATH1 Shall be of default `CHARACTER' type. - PATH2 Shall be of default `CHARACTER' type. - STATUS (Optional) Shall be of default `INTEGER' type. + PATH1 Shall be of default 'CHARACTER' type. + PATH2 Shall be of default 'CHARACTER' type. + STATUS (Optional) Shall be of default 'INTEGER' type. _See also_: *note LINK:: - File: gfortran.info, Node: REPEAT, Next: RESHAPE, Prev: RENAME, Up: Intrinsic Procedures -9.221 `REPEAT' -- Repeated string concatenation +9.228 'REPEAT' -- Repeated string concatenation =============================================== _Description_: @@ -15318,14 +16557,14 @@ _Class_: Transformational function _Syntax_: - `RESULT = REPEAT(STRING, NCOPIES)' + 'RESULT = REPEAT(STRING, NCOPIES)' _Arguments_: - STRING Shall be scalar and of type `CHARACTER'. - NCOPIES Shall be scalar and of type `INTEGER'. + STRING Shall be scalar and of type 'CHARACTER'. + NCOPIES Shall be scalar and of type 'INTEGER'. _Return value_: - A new scalar of type `CHARACTER' built up from NCOPIES copies of + A new scalar of type 'CHARACTER' built up from NCOPIES copies of STRING. _Example_: @@ -15336,11 +16575,11 @@ _Example_: File: gfortran.info, Node: RESHAPE, Next: RRSPACING, Prev: REPEAT, Up: Intrinsic Procedures -9.222 `RESHAPE' -- Function to reshape an array +9.229 'RESHAPE' -- Function to reshape an array =============================================== _Description_: - Reshapes SOURCE to correspond to SHAPE. If necessary, the new + Reshapes SOURCE to correspond to SHAPE. If necessary, the new array may be padded with elements from PAD or permuted as defined by ORDER. @@ -15351,20 +16590,19 @@ _Class_: Transformational function _Syntax_: - `RESULT = RESHAPE(SOURCE, SHAPE[, PAD, ORDER])' + 'RESULT = RESHAPE(SOURCE, SHAPE[, PAD, ORDER])' _Arguments_: - SOURCE Shall be an array of any type. - SHAPE Shall be of type `INTEGER' and an array of - rank one. Its values must be positive or zero. - PAD (Optional) shall be an array of the same type - as SOURCE. - ORDER (Optional) shall be of type `INTEGER' and an - array of the same shape as SHAPE. Its values - shall be a permutation of the numbers from 1 - to n, where n is the size of SHAPE. If ORDER - is absent, the natural ordering shall be - assumed. + SOURCE Shall be an array of any type. + SHAPE Shall be of type 'INTEGER' and an array of rank + one. Its values must be positive or zero. + PAD (Optional) shall be an array of the same type as + SOURCE. + ORDER (Optional) shall be of type 'INTEGER' and an + array of the same shape as SHAPE. Its values + shall be a permutation of the numbers from 1 to + n, where n is the size of SHAPE. If ORDER is + absent, the natural ordering shall be assumed. _Return value_: The result is an array of shape SHAPE with the same type as SOURCE. @@ -15382,11 +16620,11 @@ _See also_: File: gfortran.info, Node: RRSPACING, Next: RSHIFT, Prev: RESHAPE, Up: Intrinsic Procedures -9.223 `RRSPACING' -- Reciprocal of the relative spacing +9.230 'RRSPACING' -- Reciprocal of the relative spacing ======================================================= _Description_: - `RRSPACING(X)' returns the reciprocal of the relative spacing of + 'RRSPACING(X)' returns the reciprocal of the relative spacing of model numbers near X. _Standard_: @@ -15396,14 +16634,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = RRSPACING(X)' + 'RESULT = RRSPACING(X)' _Arguments_: - X Shall be of type `REAL'. + X Shall be of type 'REAL'. _Return value_: The return value is of the same type and kind as X. The value - returned is equal to `ABS(FRACTION(X)) * + returned is equal to 'ABS(FRACTION(X)) * FLOAT(RADIX(X))**DIGITS(X)'. _See also_: @@ -15412,18 +16650,18 @@ _See also_: File: gfortran.info, Node: RSHIFT, Next: SAME_TYPE_AS, Prev: RRSPACING, Up: Intrinsic Procedures -9.224 `RSHIFT' -- Right shift bits +9.231 'RSHIFT' -- Right shift bits ================================== _Description_: - `RSHIFT' returns a value corresponding to I with all of the bits + 'RSHIFT' returns a value corresponding to I with all of the bits shifted right by SHIFT places. If the absolute value of SHIFT is - greater than `BIT_SIZE(I)', the value is undefined. Bits shifted - out from the right end are lost. The fill is arithmetic: the bits + greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted + out from the right end are lost. The fill is arithmetic: the bits shifted in from the left end are equal to the leftmost bit, which in two's complement representation is the sign bit. - This function has been superseded by the `SHIFTA' intrinsic, which + This function has been superseded by the 'SHIFTA' intrinsic, which is standard in Fortran 2008 and later. _Standard_: @@ -15433,25 +16671,24 @@ _Class_: Elemental function _Syntax_: - `RESULT = RSHIFT(I, SHIFT)' + 'RESULT = RSHIFT(I, SHIFT)' _Arguments_: - I The type shall be `INTEGER'. - SHIFT The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + SHIFT The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. _See also_: *note ISHFT::, *note ISHFTC::, *note LSHIFT::, *note SHIFTA::, *note SHIFTR::, *note SHIFTL:: - File: gfortran.info, Node: SAME_TYPE_AS, Next: SCALE, Prev: RSHIFT, Up: Intrinsic Procedures -9.225 `SAME_TYPE_AS' -- Query dynamic types for equality -========================================================= +9.232 'SAME_TYPE_AS' -- Query dynamic types for equality +======================================================== _Description_: Query dynamic types for equality. @@ -15463,31 +16700,30 @@ _Class_: Inquiry function _Syntax_: - `RESULT = SAME_TYPE_AS(A, B)' + 'RESULT = SAME_TYPE_AS(A, B)' _Arguments_: - A Shall be an object of extensible declared type - or unlimited polymorphic. - B Shall be an object of extensible declared type - or unlimited polymorphic. + A Shall be an object of extensible declared type + or unlimited polymorphic. + B Shall be an object of extensible declared type + or unlimited polymorphic. _Return value_: - The return value is a scalar of type default logical. It is true + The return value is a scalar of type default logical. It is true if and only if the dynamic type of A is the same as the dynamic type of B. _See also_: *note EXTENDS_TYPE_OF:: - File: gfortran.info, Node: SCALE, Next: SCAN, Prev: SAME_TYPE_AS, Up: Intrinsic Procedures -9.226 `SCALE' -- Scale a real value +9.233 'SCALE' -- Scale a real value =================================== _Description_: - `SCALE(X,I)' returns `X * RADIX(X)**I'. + 'SCALE(X,I)' returns 'X * RADIX(X)**I'. _Standard_: Fortran 95 and later @@ -15496,15 +16732,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = SCALE(X, I)' + 'RESULT = SCALE(X, I)' _Arguments_: - X The type of the argument shall be a `REAL'. - I The type of the argument shall be a `INTEGER'. + X The type of the argument shall be a 'REAL'. + I The type of the argument shall be a 'INTEGER'. _Return value_: The return value is of the same type and kind as X. Its value is - `X * RADIX(X)**I'. + 'X * RADIX(X)**I'. _Example_: program test_scale @@ -15513,19 +16749,18 @@ _Example_: print *, scale(x,i), x*radix(x)**i end program test_scale - File: gfortran.info, Node: SCAN, Next: SECNDS, Prev: SCALE, Up: Intrinsic Procedures -9.227 `SCAN' -- Scan a string for the presence of a set of characters +9.234 'SCAN' -- Scan a string for the presence of a set of characters ===================================================================== _Description_: Scans a STRING for any of the characters in a SET of characters. - If BACK is either absent or equals `FALSE', this function returns + If BACK is either absent or equals 'FALSE', this function returns the position of the leftmost character of STRING that is in SET. - If BACK equals `TRUE', the rightmost position is returned. If no + If BACK equals 'TRUE', the rightmost position is returned. If no character of SET is found in STRING, the result is zero. _Standard_: @@ -15535,18 +16770,18 @@ _Class_: Elemental function _Syntax_: - `RESULT = SCAN(STRING, SET[, BACK [, KIND]])' + 'RESULT = SCAN(STRING, SET[, BACK [, KIND]])' _Arguments_: - STRING Shall be of type `CHARACTER'. - SET Shall be of type `CHARACTER'. - BACK (Optional) shall be of type `LOGICAL'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + STRING Shall be of type 'CHARACTER'. + SET Shall be of type 'CHARACTER'. + BACK (Optional) shall be of type 'LOGICAL'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. _Example_: @@ -15562,13 +16797,13 @@ _See also_: File: gfortran.info, Node: SECNDS, Next: SECOND, Prev: SCAN, Up: Intrinsic Procedures -9.228 `SECNDS' -- Time function +9.235 'SECNDS' -- Time function =============================== _Description_: - `SECNDS(X)' gets the time in seconds from the real-time system - clock. X is a reference time, also in seconds. If this is zero, - the time in seconds from midnight is returned. This function is + 'SECNDS(X)' gets the time in seconds from the real-time system + clock. X is a reference time, also in seconds. If this is zero, + the time in seconds from midnight is returned. This function is non-standard and its use is discouraged. _Standard_: @@ -15578,11 +16813,11 @@ _Class_: Function _Syntax_: - `RESULT = SECNDS (X)' + 'RESULT = SECNDS (X)' _Arguments_: - T Shall be of type `REAL(4)'. - X Shall be of type `REAL(4)'. + T Shall be of type 'REAL(4)'. + X Shall be of type 'REAL(4)'. _Return value_: None @@ -15602,13 +16837,13 @@ _Example_: File: gfortran.info, Node: SECOND, Next: SELECTED_CHAR_KIND, Prev: SECNDS, Up: Intrinsic Procedures -9.229 `SECOND' -- CPU time function +9.236 'SECOND' -- CPU time function =================================== _Description_: - Returns a `REAL(4)' value representing the elapsed CPU time in + Returns a 'REAL(4)' value representing the elapsed CPU time in seconds. This provides the same functionality as the standard - `CPU_TIME' intrinsic, and is only included for backwards + 'CPU_TIME' intrinsic, and is only included for backwards compatibility. This intrinsic is provided in both subroutine and function forms; @@ -15621,11 +16856,11 @@ _Class_: Subroutine, function _Syntax_: - `CALL SECOND(TIME)' - `TIME = SECOND()' + 'CALL SECOND(TIME)' + 'TIME = SECOND()' _Arguments_: - TIME Shall be of type `REAL(4)'. + TIME Shall be of type 'REAL(4)'. _Return value_: In either syntax, TIME is set to the process's current runtime in @@ -15634,17 +16869,17 @@ _Return value_: _See also_: *note CPU_TIME:: - File: gfortran.info, Node: SELECTED_CHAR_KIND, Next: SELECTED_INT_KIND, Prev: SECOND, Up: Intrinsic Procedures -9.230 `SELECTED_CHAR_KIND' -- Choose character kind +9.237 'SELECTED_CHAR_KIND' -- Choose character kind =================================================== _Description_: - `SELECTED_CHAR_KIND(NAME)' returns the kind value for the character + + 'SELECTED_CHAR_KIND(NAME)' returns the kind value for the character set named NAME, if a character set with such a name is supported, - or -1 otherwise. Currently, supported character sets include + or -1 otherwise. Currently, supported character sets include "ASCII" and "DEFAULT", which are equivalent, and "ISO_10646" (Universal Character Set, UCS-4) which is commonly known as Unicode. @@ -15656,11 +16891,11 @@ _Class_: Transformational function _Syntax_: - `RESULT = SELECTED_CHAR_KIND(NAME)' + 'RESULT = SELECTED_CHAR_KIND(NAME)' _Arguments_: - NAME Shall be a scalar and of the default character - type. + NAME Shall be a scalar and of the default character + type. _Example_: program character_kind @@ -15686,14 +16921,14 @@ _Example_: File: gfortran.info, Node: SELECTED_INT_KIND, Next: SELECTED_REAL_KIND, Prev: SELECTED_CHAR_KIND, Up: Intrinsic Procedures -9.231 `SELECTED_INT_KIND' -- Choose integer kind +9.238 'SELECTED_INT_KIND' -- Choose integer kind ================================================ _Description_: - `SELECTED_INT_KIND(R)' return the kind value of the smallest + 'SELECTED_INT_KIND(R)' return the kind value of the smallest integer type that can represent all values ranging from -10^R - (exclusive) to 10^R (exclusive). If there is no integer kind that - accommodates this range, `SELECTED_INT_KIND' returns -1. + (exclusive) to 10^R (exclusive). If there is no integer kind that + accommodates this range, 'SELECTED_INT_KIND' returns -1. _Standard_: Fortran 95 and later @@ -15702,10 +16937,10 @@ _Class_: Transformational function _Syntax_: - `RESULT = SELECTED_INT_KIND(R)' + 'RESULT = SELECTED_INT_KIND(R)' _Arguments_: - R Shall be a scalar and of type `INTEGER'. + R Shall be a scalar and of type 'INTEGER'. _Example_: program large_integers @@ -15724,57 +16959,54 @@ _Example_: File: gfortran.info, Node: SELECTED_REAL_KIND, Next: SET_EXPONENT, Prev: SELECTED_INT_KIND, Up: Intrinsic Procedures -9.232 `SELECTED_REAL_KIND' -- Choose real kind +9.239 'SELECTED_REAL_KIND' -- Choose real kind ============================================== _Description_: - `SELECTED_REAL_KIND(P,R)' returns the kind value of a real data - type with decimal precision of at least `P' digits, exponent range - of at least `R', and with a radix of `RADIX'. + 'SELECTED_REAL_KIND(P,R)' returns the kind value of a real data + type with decimal precision of at least 'P' digits, exponent range + of at least 'R', and with a radix of 'RADIX'. _Standard_: - Fortran 95 and later, with `RADIX' Fortran 2008 or later + Fortran 95 and later, with 'RADIX' Fortran 2008 or later _Class_: Transformational function _Syntax_: - `RESULT = SELECTED_REAL_KIND([P, R, RADIX])' + 'RESULT = SELECTED_REAL_KIND([P, R, RADIX])' _Arguments_: - P (Optional) shall be a scalar and of type - `INTEGER'. - R (Optional) shall be a scalar and of type - `INTEGER'. - RADIX (Optional) shall be a scalar and of type - `INTEGER'. + P (Optional) shall be a scalar and of type + 'INTEGER'. + R (Optional) shall be a scalar and of type + 'INTEGER'. + RADIX (Optional) shall be a scalar and of type + 'INTEGER'. Before Fortran 2008, at least one of the arguments R or P shall be present; since Fortran 2008, they are assumed to be zero if absent. _Return value_: - `SELECTED_REAL_KIND' returns the value of the kind type parameter - of a real data type with decimal precision of at least `P' digits, - a decimal exponent range of at least `R', and with the requested - `RADIX'. If the `RADIX' parameter is absent, real kinds with any - radix can be returned. If more than one real data type meet the + + 'SELECTED_REAL_KIND' returns the value of the kind type parameter + of a real data type with decimal precision of at least 'P' digits, + a decimal exponent range of at least 'R', and with the requested + 'RADIX'. If the 'RADIX' parameter is absent, real kinds with any + radix can be returned. If more than one real data type meet the criteria, the kind of the data type with the smallest decimal - precision is returned. If no real data type matches the criteria, + precision is returned. If no real data type matches the criteria, the result is - -1 if the processor does not support a real data type with a - precision greater than or equal to `P', but the `R' and - `RADIX' requirements can be fulfilled - - -2 if the processor does not support a real type with an exponent - range greater than or equal to `R', but `P' and `RADIX' are + -1 if the processor does not support a real data type with a + precision greater than or equal to 'P', but the 'R' and + 'RADIX' requirements can be fulfilled + -2 if the processor does not support a real type with an exponent + range greater than or equal to 'R', but 'P' and 'RADIX' are fulfillable - - -3 if `RADIX' but not `P' and `R' requirements + -3 if 'RADIX' but not 'P' and 'R' requirements are fulfillable - - -4 if `RADIX' and either `P' or `R' requirements + -4 if 'RADIX' and either 'P' or 'R' requirements are fulfillable - - -5 if there is no real type with the given `RADIX' + -5 if there is no real type with the given 'RADIX' _See also_: *note PRECISION::, *note RANGE::, *note RADIX:: @@ -15796,11 +17028,11 @@ _Example_: File: gfortran.info, Node: SET_EXPONENT, Next: SHAPE, Prev: SELECTED_REAL_KIND, Up: Intrinsic Procedures -9.233 `SET_EXPONENT' -- Set the exponent of the model +9.240 'SET_EXPONENT' -- Set the exponent of the model ===================================================== _Description_: - `SET_EXPONENT(X, I)' returns the real number whose fractional part + 'SET_EXPONENT(X, I)' returns the real number whose fractional part is that that of X and whose exponent part is I. _Standard_: @@ -15810,16 +17042,16 @@ _Class_: Elemental function _Syntax_: - `RESULT = SET_EXPONENT(X, I)' + 'RESULT = SET_EXPONENT(X, I)' _Arguments_: - X Shall be of type `REAL'. - I Shall be of type `INTEGER'. + X Shall be of type 'REAL'. + I Shall be of type 'INTEGER'. _Return value_: The return value is of the same type and kind as X. The real number whose fractional part is that that of X and whose exponent - part if I is returned; it is `FRACTION(X) * RADIX(X)**I'. + part if I is returned; it is 'FRACTION(X) * RADIX(X)**I'. _Example_: PROGRAM test_setexp @@ -15828,11 +17060,10 @@ _Example_: PRINT *, SET_EXPONENT(x, i), FRACTION(x) * RADIX(x)**i END PROGRAM - File: gfortran.info, Node: SHAPE, Next: SHIFTA, Prev: SET_EXPONENT, Up: Intrinsic Procedures -9.234 `SHAPE' -- Determine the shape of an array +9.241 'SHAPE' -- Determine the shape of an array ================================================ _Description_: @@ -15845,23 +17076,23 @@ _Class_: Inquiry function _Syntax_: - `RESULT = SHAPE(SOURCE [, KIND])' + 'RESULT = SHAPE(SOURCE [, KIND])' _Arguments_: - SOURCE Shall be an array or scalar of any type. If - SOURCE is a pointer it must be associated and - allocatable arrays must be allocated. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + SOURCE Shall be an array or scalar of any type. If + SOURCE is a pointer it must be associated and + allocatable arrays must be allocated. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - An `INTEGER' array of rank one with as many elements as SOURCE has - dimensions. The elements of the resulting array correspond to the - extend of SOURCE along the respective dimensions. If SOURCE is a - scalar, the result is the rank one array of size zero. If KIND is - absent, the return value has the default integer kind otherwise - the specified kind. + An 'INTEGER' array of rank one with as many elements as SOURCE has + dimensions. The elements of the resulting array correspond to the + extend of SOURCE along the respective dimensions. If SOURCE is a + scalar, the result is the rank one array of size zero. If KIND is + absent, the return value has the default integer kind otherwise the + specified kind. _Example_: PROGRAM test_shape @@ -15876,14 +17107,14 @@ _See also_: File: gfortran.info, Node: SHIFTA, Next: SHIFTL, Prev: SHAPE, Up: Intrinsic Procedures -9.235 `SHIFTA' -- Right shift with fill +9.242 'SHIFTA' -- Right shift with fill ======================================= _Description_: - `SHIFTA' returns a value corresponding to I with all of the bits + 'SHIFTA' returns a value corresponding to I with all of the bits shifted right by SHIFT places. If the absolute value of SHIFT is - greater than `BIT_SIZE(I)', the value is undefined. Bits shifted - out from the right end are lost. The fill is arithmetic: the bits + greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted + out from the right end are lost. The fill is arithmetic: the bits shifted in from the left end are equal to the leftmost bit, which in two's complement representation is the sign bit. @@ -15894,14 +17125,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = SHIFTA(I, SHIFT)' + 'RESULT = SHIFTA(I, SHIFT)' _Arguments_: - I The type shall be `INTEGER'. - SHIFT The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + SHIFT The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. _See also_: *note SHIFTL::, *note SHIFTR:: @@ -15909,13 +17140,13 @@ _See also_: File: gfortran.info, Node: SHIFTL, Next: SHIFTR, Prev: SHIFTA, Up: Intrinsic Procedures -9.236 `SHIFTL' -- Left shift +9.243 'SHIFTL' -- Left shift ============================ _Description_: - `SHIFTL' returns a value corresponding to I with all of the bits + 'SHIFTL' returns a value corresponding to I with all of the bits shifted left by SHIFT places. If the absolute value of SHIFT is - greater than `BIT_SIZE(I)', the value is undefined. Bits shifted + greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted out from the left end are lost, and bits shifted in from the right end are set to 0. @@ -15926,14 +17157,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = SHIFTL(I, SHIFT)' + 'RESULT = SHIFTL(I, SHIFT)' _Arguments_: - I The type shall be `INTEGER'. - SHIFT The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + SHIFT The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. _See also_: *note SHIFTA::, *note SHIFTR:: @@ -15941,13 +17172,13 @@ _See also_: File: gfortran.info, Node: SHIFTR, Next: SIGN, Prev: SHIFTL, Up: Intrinsic Procedures -9.237 `SHIFTR' -- Right shift +9.244 'SHIFTR' -- Right shift ============================= _Description_: - `SHIFTR' returns a value corresponding to I with all of the bits + 'SHIFTR' returns a value corresponding to I with all of the bits shifted right by SHIFT places. If the absolute value of SHIFT is - greater than `BIT_SIZE(I)', the value is undefined. Bits shifted + greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted out from the right end are lost, and bits shifted in from the left end are set to 0. @@ -15958,14 +17189,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = SHIFTR(I, SHIFT)' + 'RESULT = SHIFTR(I, SHIFT)' _Arguments_: - I The type shall be `INTEGER'. - SHIFT The type shall be `INTEGER'. + I The type shall be 'INTEGER'. + SHIFT The type shall be 'INTEGER'. _Return value_: - The return value is of type `INTEGER' and of the same kind as I. + The return value is of type 'INTEGER' and of the same kind as I. _See also_: *note SHIFTA::, *note SHIFTL:: @@ -15973,11 +17204,11 @@ _See also_: File: gfortran.info, Node: SIGN, Next: SIGNAL, Prev: SHIFTR, Up: Intrinsic Procedures -9.238 `SIGN' -- Sign copying function +9.245 'SIGN' -- Sign copying function ===================================== _Description_: - `SIGN(A,B)' returns the value of A with the sign of B. + 'SIGN(A,B)' returns the value of A with the sign of B. _Standard_: Fortran 77 and later @@ -15986,15 +17217,15 @@ _Class_: Elemental function _Syntax_: - `RESULT = SIGN(A, B)' + 'RESULT = SIGN(A, B)' _Arguments_: - A Shall be of type `INTEGER' or `REAL' - B Shall be of the same type and kind as A + A Shall be of type 'INTEGER' or 'REAL' + B Shall be of the same type and kind as A _Return value_: The kind of the return value is that of A and B. If B\ge 0 then - the result is `ABS(A)', else it is `-ABS(A)'. + the result is 'ABS(A)', else it is '-ABS(A)'. _Example_: program test_sign @@ -16008,29 +17239,29 @@ _Example_: end program test_sign _Specific names_: - Name Arguments Return type Standard - `SIGN(A,B)' `REAL(4) A, `REAL(4)' f77, gnu - B' - `ISIGN(A,B)' `INTEGER(4) `INTEGER(4)' f77, gnu - A, B' - `DSIGN(A,B)' `REAL(8) A, `REAL(8)' f77, gnu - B' + Name Arguments Return type Standard + 'SIGN(A,B)' 'REAL(4) A, 'REAL(4)' f77, gnu + B' + 'ISIGN(A,B)' 'INTEGER(4) 'INTEGER(4)' f77, gnu + A, B' + 'DSIGN(A,B)' 'REAL(8) A, 'REAL(8)' f77, gnu + B' File: gfortran.info, Node: SIGNAL, Next: SIN, Prev: SIGN, Up: Intrinsic Procedures -9.239 `SIGNAL' -- Signal handling subroutine (or function) +9.246 'SIGNAL' -- Signal handling subroutine (or function) ========================================================== _Description_: - `SIGNAL(NUMBER, HANDLER [, STATUS])' causes external subroutine + 'SIGNAL(NUMBER, HANDLER [, STATUS])' causes external subroutine HANDLER to be executed with a single integer argument when signal NUMBER occurs. If HANDLER is an integer, it can be used to turn - off handling of signal NUMBER or revert to its default action. - See `signal(2)'. + off handling of signal NUMBER or revert to its default action. See + 'signal(2)'. - If `SIGNAL' is called as a subroutine and the STATUS argument is - supplied, it is set to the value returned by `signal(2)'. + If 'SIGNAL' is called as a subroutine and the STATUS argument is + supplied, it is set to the value returned by 'signal(2)'. _Standard_: GNU extension @@ -16039,19 +17270,19 @@ _Class_: Subroutine, function _Syntax_: - `CALL SIGNAL(NUMBER, HANDLER [, STATUS])' - `STATUS = SIGNAL(NUMBER, HANDLER)' + 'CALL SIGNAL(NUMBER, HANDLER [, STATUS])' + 'STATUS = SIGNAL(NUMBER, HANDLER)' _Arguments_: - NUMBER Shall be a scalar integer, with `INTENT(IN)' - HANDLER Signal handler (`INTEGER FUNCTION' or - `SUBROUTINE') or dummy/global `INTEGER' scalar. - `INTEGER'. It is `INTENT(IN)'. - STATUS (Optional) STATUS shall be a scalar integer. - It has `INTENT(OUT)'. + NUMBER Shall be a scalar integer, with 'INTENT(IN)' + HANDLER Signal handler ('INTEGER FUNCTION' or + 'SUBROUTINE') or dummy/global 'INTEGER' scalar. + 'INTEGER'. It is 'INTENT(IN)'. + STATUS (Optional) STATUS shall be a scalar integer. It + has 'INTENT(OUT)'. _Return value_: - The `SIGNAL' function returns the value returned by `signal(2)'. + The 'SIGNAL' function returns the value returned by 'signal(2)'. _Example_: program test_signal @@ -16065,13 +17296,13 @@ _Example_: end program test_signal -File: gfortran.info, Node: SIN, Next: SINH, Prev: SIGNAL, Up: Intrinsic Procedures +File: gfortran.info, Node: SIN, Next: SIND, Prev: SIGNAL, Up: Intrinsic Procedures -9.240 `SIN' -- Sine function +9.247 'SIN' -- Sine function ============================ _Description_: - `SIN(X)' computes the sine of X. + 'SIN(X)' computes the sine of X. _Standard_: Fortran 77 and later @@ -16080,10 +17311,10 @@ _Class_: Elemental function _Syntax_: - `RESULT = SIN(X)' + 'RESULT = SIN(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: The return value has same type and kind as X. @@ -16095,27 +17326,75 @@ _Example_: end program test_sin _Specific names_: - Name Argument Return type Standard - `SIN(X)' `REAL(4) X' `REAL(4)' f77, gnu - `DSIN(X)' `REAL(8) X' `REAL(8)' f95, gnu - `CSIN(X)' `COMPLEX(4) `COMPLEX(4)' f95, gnu - X' - `ZSIN(X)' `COMPLEX(8) `COMPLEX(8)' f95, gnu - X' - `CDSIN(X)' `COMPLEX(8) `COMPLEX(8)' f95, gnu - X' + Name Argument Return type Standard + 'SIN(X)' 'REAL(4) X' 'REAL(4)' f77, gnu + 'DSIN(X)' 'REAL(8) X' 'REAL(8)' f95, gnu + 'CSIN(X)' 'COMPLEX(4) 'COMPLEX(4)' f95, gnu + X' + 'ZSIN(X)' 'COMPLEX(8) 'COMPLEX(8)' f95, gnu + X' + 'CDSIN(X)' 'COMPLEX(8) 'COMPLEX(8)' f95, gnu + X' + +_See also_: + Inverse function: *note ASIN:: Degrees function: *note SIND:: + + +File: gfortran.info, Node: SIND, Next: SINH, Prev: SIN, Up: Intrinsic Procedures + +9.248 'SIND' -- Sine function, degrees +====================================== + +_Description_: + 'SIND(X)' computes the sine of X in degrees. + + This function is for compatibility only and should be avoided in + favor of standard constructs wherever possible. + +_Standard_: + GNU Extension, enabled with '-fdec-math'. + +_Class_: + Elemental function + +_Syntax_: + 'RESULT = SIND(X)' + +_Arguments_: + X The type shall be 'REAL' or 'COMPLEX'. + +_Return value_: + The return value has same type and kind as X, and its value is in + degrees. + +_Example_: + program test_sind + real :: x = 0.0 + x = sind(x) + end program test_sind + +_Specific names_: + Name Argument Return type Standard + 'SIND(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DSIND(X)' 'REAL(8) X' 'REAL(8)' GNU Extension + 'CSIND(X)' 'COMPLEX(4) 'COMPLEX(4)' GNU Extension + X' + 'ZSIND(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU Extension + X' + 'CDSIND(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU Extension + X' _See also_: - *note ASIN:: + Inverse function: *note ASIND:: Radians function: *note SIN:: -File: gfortran.info, Node: SINH, Next: SIZE, Prev: SIN, Up: Intrinsic Procedures +File: gfortran.info, Node: SINH, Next: SIZE, Prev: SIND, Up: Intrinsic Procedures -9.241 `SINH' -- Hyperbolic sine function +9.249 'SINH' -- Hyperbolic sine function ======================================== _Description_: - `SINH(X)' computes the hyperbolic sine of X. + 'SINH(X)' computes the hyperbolic sine of X. _Standard_: Fortran 95 and later, for a complex argument Fortran 2008 or later @@ -16124,10 +17403,10 @@ _Class_: Elemental function _Syntax_: - `RESULT = SINH(X)' + 'RESULT = SINH(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: The return value has same type and kind as X. @@ -16139,11 +17418,11 @@ _Example_: end program test_sinh _Specific names_: - Name Argument Return type Standard - `SINH(X)' `REAL(4) X' `REAL(4)' Fortran 95 and - later - `DSINH(X)' `REAL(8) X' `REAL(8)' Fortran 95 and - later + Name Argument Return type Standard + 'SINH(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and + later + 'DSINH(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and + later _See also_: *note ASINH:: @@ -16151,7 +17430,7 @@ _See also_: File: gfortran.info, Node: SIZE, Next: SIZEOF, Prev: SINH, Up: Intrinsic Procedures -9.242 `SIZE' -- Determine the size of an array +9.250 'SIZE' -- Determine the size of an array ============================================== _Description_: @@ -16165,21 +17444,21 @@ _Class_: Inquiry function _Syntax_: - `RESULT = SIZE(ARRAY[, DIM [, KIND]])' + 'RESULT = SIZE(ARRAY[, DIM [, KIND]])' _Arguments_: - ARRAY Shall be an array of any type. If ARRAY is a - pointer it must be associated and allocatable - arrays must be allocated. - DIM (Optional) shall be a scalar of type `INTEGER' - and its value shall be in the range from 1 to - n, where n equals the rank of ARRAY. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + ARRAY Shall be an array of any type. If ARRAY is a + pointer it must be associated and allocatable + arrays must be allocated. + DIM (Optional) shall be a scalar of type 'INTEGER' + and its value shall be in the range from 1 to n, + where n equals the rank of ARRAY. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. _Example_: @@ -16193,12 +17472,12 @@ _See also_: File: gfortran.info, Node: SIZEOF, Next: SLEEP, Prev: SIZE, Up: Intrinsic Procedures -9.243 `SIZEOF' -- Size in bytes of an expression +9.251 'SIZEOF' -- Size in bytes of an expression ================================================ _Description_: - `SIZEOF(X)' calculates the number of bytes of storage the - expression `X' occupies. + 'SIZEOF(X)' calculates the number of bytes of storage the + expression 'X' occupies. _Standard_: GNU extension @@ -16207,23 +17486,23 @@ _Class_: Inquiry function _Syntax_: - `N = SIZEOF(X)' + 'N = SIZEOF(X)' _Arguments_: - X The argument shall be of any type, rank or - shape. + X The argument shall be of any type, rank or + shape. _Return value_: The return value is of type integer and of the system-dependent - kind C_SIZE_T (from the ISO_C_BINDING module). Its value is the + kind C_SIZE_T (from the ISO_C_BINDING module). Its value is the number of bytes occupied by the argument. If the argument has the - `POINTER' attribute, the number of bytes of the storage area + 'POINTER' attribute, the number of bytes of the storage area pointed to is returned. If the argument is of a derived type with - `POINTER' or `ALLOCATABLE' components, the return value does not + 'POINTER' or 'ALLOCATABLE' components, the return value does not account for the sizes of the data pointed to by these components. If the argument is polymorphic, the size according to the dynamic - type is returned. The argument may not be a procedure or procedure - pointer. Note that the code assumes for arrays that those are + type is returned. The argument may not be a procedure or procedure + pointer. Note that the code assumes for arrays that those are contiguous; for contiguous arrays, it returns the storage or an array element multiplied by the size of the array. @@ -16232,8 +17511,8 @@ _Example_: real :: r, s(5) print *, (sizeof(s)/sizeof(r) == 5) end - The example will print `.TRUE.' unless you are using a platform - where default `REAL' variables are unusually padded. + The example will print '.TRUE.' unless you are using a platform + where default 'REAL' variables are unusually padded. _See also_: *note C_SIZEOF::, *note STORAGE_SIZE:: @@ -16241,7 +17520,7 @@ _See also_: File: gfortran.info, Node: SLEEP, Next: SPACING, Prev: SIZEOF, Up: Intrinsic Procedures -9.244 `SLEEP' -- Sleep for the specified number of seconds +9.252 'SLEEP' -- Sleep for the specified number of seconds ========================================================== _Description_: @@ -16255,10 +17534,10 @@ _Class_: Subroutine _Syntax_: - `CALL SLEEP(SECONDS)' + 'CALL SLEEP(SECONDS)' _Arguments_: - SECONDS The type shall be of default `INTEGER'. + SECONDS The type shall be of default 'INTEGER'. _Example_: program test_sleep @@ -16268,7 +17547,7 @@ _Example_: File: gfortran.info, Node: SPACING, Next: SPREAD, Prev: SLEEP, Up: Intrinsic Procedures -9.245 `SPACING' -- Smallest distance between two numbers of a given type +9.253 'SPACING' -- Smallest distance between two numbers of a given type ======================================================================== _Description_: @@ -16282,10 +17561,10 @@ _Class_: Elemental function _Syntax_: - `RESULT = SPACING(X)' + 'RESULT = SPACING(X)' _Arguments_: - X Shall be of type `REAL'. + X Shall be of type 'REAL'. _Return value_: The result is of the same type as the input argument X. @@ -16305,12 +17584,12 @@ _See also_: File: gfortran.info, Node: SPREAD, Next: SQRT, Prev: SPACING, Up: Intrinsic Procedures -9.246 `SPREAD' -- Add a dimension to an array +9.254 'SPREAD' -- Add a dimension to an array ============================================= _Description_: - Replicates a SOURCE array NCOPIES times along a specified - dimension DIM. + Replicates a SOURCE array NCOPIES times along a specified dimension + DIM. _Standard_: Fortran 95 and later @@ -16319,15 +17598,15 @@ _Class_: Transformational function _Syntax_: - `RESULT = SPREAD(SOURCE, DIM, NCOPIES)' + 'RESULT = SPREAD(SOURCE, DIM, NCOPIES)' _Arguments_: - SOURCE Shall be a scalar or an array of any type and - a rank less than seven. - DIM Shall be a scalar of type `INTEGER' with a - value in the range from 1 to n+1, where n - equals the rank of SOURCE. - NCOPIES Shall be a scalar of type `INTEGER'. + SOURCE Shall be a scalar or an array of any type and a + rank less than seven. + DIM Shall be a scalar of type 'INTEGER' with a value + in the range from 1 to n+1, where n equals the + rank of SOURCE. + NCOPIES Shall be a scalar of type 'INTEGER'. _Return value_: The result is an array of the same type as SOURCE and has rank n+1 @@ -16346,11 +17625,11 @@ _See also_: File: gfortran.info, Node: SQRT, Next: SRAND, Prev: SPREAD, Up: Intrinsic Procedures -9.247 `SQRT' -- Square-root function +9.255 'SQRT' -- Square-root function ==================================== _Description_: - `SQRT(X)' computes the square root of X. + 'SQRT(X)' computes the square root of X. _Standard_: Fortran 77 and later @@ -16359,13 +17638,13 @@ _Class_: Elemental function _Syntax_: - `RESULT = SQRT(X)' + 'RESULT = SQRT(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: - The return value is of type `REAL' or `COMPLEX'. The kind type + The return value is of type 'REAL' or 'COMPLEX'. The kind type parameter is the same as X. _Example_: @@ -16377,27 +17656,27 @@ _Example_: end program test_sqrt _Specific names_: - Name Argument Return type Standard - `SQRT(X)' `REAL(4) X' `REAL(4)' Fortran 95 and - later - `DSQRT(X)' `REAL(8) X' `REAL(8)' Fortran 95 and - later - `CSQRT(X)' `COMPLEX(4) `COMPLEX(4)' Fortran 95 and - X' later - `ZSQRT(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension - X' - `CDSQRT(X)' `COMPLEX(8) `COMPLEX(8)' GNU extension - X' + Name Argument Return type Standard + 'SQRT(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and + later + 'DSQRT(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and + later + 'CSQRT(X)' 'COMPLEX(4) 'COMPLEX(4)' Fortran 95 and + X' later + 'ZSQRT(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + X' + 'CDSQRT(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension + X' File: gfortran.info, Node: SRAND, Next: STAT, Prev: SQRT, Up: Intrinsic Procedures -9.248 `SRAND' -- Reinitialize the random number generator +9.256 'SRAND' -- Reinitialize the random number generator ========================================================= _Description_: - `SRAND' reinitializes the pseudo-random number generator called by - `RAND' and `IRAND'. The new seed used by the generator is + 'SRAND' reinitializes the pseudo-random number generator called by + 'RAND' and 'IRAND'. The new seed used by the generator is specified by the required argument SEED. _Standard_: @@ -16407,59 +17686,57 @@ _Class_: Subroutine _Syntax_: - `CALL SRAND(SEED)' + 'CALL SRAND(SEED)' _Arguments_: - SEED Shall be a scalar `INTEGER(kind=4)'. + SEED Shall be a scalar 'INTEGER(kind=4)'. _Return value_: Does not return anything. _Example_: - See `RAND' and `IRAND' for examples. + See 'RAND' and 'IRAND' for examples. _Notes_: The Fortran standard specifies the intrinsic subroutines - `RANDOM_SEED' to initialize the pseudo-random number generator and - `RANDOM_NUMBER' to generate pseudo-random numbers. These + 'RANDOM_SEED' to initialize the pseudo-random number generator and + 'RANDOM_NUMBER' to generate pseudo-random numbers. These subroutines should be used in new codes. Please note that in GNU Fortran, these two sets of intrinsics - (`RAND', `IRAND' and `SRAND' on the one hand, `RANDOM_NUMBER' and - `RANDOM_SEED' on the other hand) access two independent + ('RAND', 'IRAND' and 'SRAND' on the one hand, 'RANDOM_NUMBER' and + 'RANDOM_SEED' on the other hand) access two independent pseudo-random number generators. _See also_: *note RAND::, *note RANDOM_SEED::, *note RANDOM_NUMBER:: - File: gfortran.info, Node: STAT, Next: STORAGE_SIZE, Prev: SRAND, Up: Intrinsic Procedures -9.249 `STAT' -- Get file status +9.257 'STAT' -- Get file status =============================== _Description_: - This function returns information about a file. No permissions are + This function returns information about a file. No permissions are required on the file itself, but execute (search) permission is required on all of the directories in path that lead to the file. - The elements that are obtained and stored in the array `VALUES': - `VALUES(1)'Device ID - `VALUES(2)'Inode number - `VALUES(3)'File mode - `VALUES(4)'Number of links - `VALUES(5)'Owner's uid - `VALUES(6)'Owner's gid - `VALUES(7)'ID of device containing directory entry for - file (0 if not available) - `VALUES(8)'File size (bytes) - `VALUES(9)'Last access time - `VALUES(10)'Last modification time - `VALUES(11)'Last file status change time - `VALUES(12)'Preferred I/O block size (-1 if not available) - `VALUES(13)'Number of blocks allocated (-1 if not - available) + The elements that are obtained and stored in the array 'VALUES': + 'VALUES(1)' Device ID + 'VALUES(2)' Inode number + 'VALUES(3)' File mode + 'VALUES(4)' Number of links + 'VALUES(5)' Owner's uid + 'VALUES(6)' Owner's gid + 'VALUES(7)' ID of device containing directory entry for file + (0 if not available) + 'VALUES(8)' File size (bytes) + 'VALUES(9)' Last access time + 'VALUES(10)'Last modification time + 'VALUES(11)'Last file status change time + 'VALUES(12)'Preferred I/O block size (-1 if not available) + 'VALUES(13)'Number of blocks allocated (-1 if not available) Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. @@ -16474,16 +17751,16 @@ _Class_: Subroutine, function _Syntax_: - `CALL STAT(NAME, VALUES [, STATUS])' - `STATUS = STAT(NAME, VALUES)' + 'CALL STAT(NAME, VALUES [, STATUS])' + 'STATUS = STAT(NAME, VALUES)' _Arguments_: - NAME The type shall be `CHARACTER', of the default - kind and a valid path within the file system. - VALUES The type shall be `INTEGER(4), DIMENSION(13)'. - STATUS (Optional) status flag of type `INTEGER(4)'. - Returns 0 on success and a system specific - error code otherwise. + NAME The type shall be 'CHARACTER', of the default + kind and a valid path within the file system. + VALUES The type shall be 'INTEGER(4), DIMENSION(13)'. + STATUS (Optional) status flag of type 'INTEGER(4)'. + Returns 0 on success and a system specific error + code otherwise. _Example_: PROGRAM test_stat @@ -16515,31 +17792,28 @@ _See also_: File: gfortran.info, Node: STORAGE_SIZE, Next: SUM, Prev: STAT, Up: Intrinsic Procedures -9.250 `STORAGE_SIZE' -- Storage size in bits +9.258 'STORAGE_SIZE' -- Storage size in bits ============================================ _Description_: Returns the storage size of argument A in bits. - _Standard_: Fortran 2008 and later - _Class_: Inquiry function - _Syntax_: - `RESULT = STORAGE_SIZE(A [, KIND])' + 'RESULT = STORAGE_SIZE(A [, KIND])' _Arguments_: - A Shall be a scalar or array of any type. - KIND (Optional) shall be a scalar integer constant - expression. + A Shall be a scalar or array of any type. + KIND (Optional) shall be a scalar integer constant + expression. _Return Value_: The result is a scalar integer with the kind type parameter specified by KIND (or default integer type if KIND is missing). - The result value is the size expressed in bits for an element of - an array that has the dynamic type and type parameters of A. + The result value is the size expressed in bits for an element of an + array that has the dynamic type and type parameters of A. _See also_: *note C_SIZEOF::, *note SIZEOF:: @@ -16547,12 +17821,12 @@ _See also_: File: gfortran.info, Node: SUM, Next: SYMLNK, Prev: STORAGE_SIZE, Up: Intrinsic Procedures -9.251 `SUM' -- Sum of array elements +9.259 'SUM' -- Sum of array elements ==================================== _Description_: - Adds the elements of ARRAY along dimension DIM if the - corresponding element in MASK is `TRUE'. + Adds the elements of ARRAY along dimension DIM if the corresponding + element in MASK is 'TRUE'. _Standard_: Fortran 95 and later @@ -16561,26 +17835,26 @@ _Class_: Transformational function _Syntax_: - `RESULT = SUM(ARRAY[, MASK])' - `RESULT = SUM(ARRAY, DIM[, MASK])' + 'RESULT = SUM(ARRAY[, MASK])' + 'RESULT = SUM(ARRAY, DIM[, MASK])' _Arguments_: - ARRAY Shall be an array of type `INTEGER', `REAL' or - `COMPLEX'. - DIM (Optional) shall be a scalar of type `INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type `LOGICAL' and - either be a scalar or an array of the same - shape as ARRAY. + ARRAY Shall be an array of type 'INTEGER', 'REAL' or + 'COMPLEX'. + DIM (Optional) shall be a scalar of type 'INTEGER' + with a value in the range from 1 to n, where n + equals the rank of ARRAY. + MASK (Optional) shall be of type 'LOGICAL' and either + be a scalar or an array of the same shape as + ARRAY. _Return value_: The result is of the same type as ARRAY. - If DIM is absent, a scalar with the sum of all elements in ARRAY - is returned. Otherwise, an array of rank n-1, where n equals the - rank of ARRAY, and a shape similar to that of ARRAY with dimension - DIM dropped is returned. + If DIM is absent, a scalar with the sum of all elements in ARRAY is + returned. Otherwise, an array of rank n-1, where n equals the rank + of ARRAY, and a shape similar to that of ARRAY with dimension DIM + dropped is returned. _Example_: PROGRAM test_sum @@ -16595,16 +17869,16 @@ _See also_: File: gfortran.info, Node: SYMLNK, Next: SYSTEM, Prev: SUM, Up: Intrinsic Procedures -9.252 `SYMLNK' -- Create a symbolic link +9.260 'SYMLNK' -- Create a symbolic link ======================================== _Description_: - Makes a symbolic link from file PATH1 to PATH2. A null character - (`CHAR(0)') can be used to mark the end of the names in PATH1 and + Makes a symbolic link from file PATH1 to PATH2. A null character + ('CHAR(0)') can be used to mark the end of the names in PATH1 and PATH2; otherwise, trailing blanks in the file names are ignored. If the STATUS argument is supplied, it contains 0 on success or a - nonzero error code upon return; see `symlink(2)'. If the system - does not supply `symlink(2)', `ENOSYS' is returned. + nonzero error code upon return; see 'symlink(2)'. If the system + does not supply 'symlink(2)', 'ENOSYS' is returned. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -16616,36 +17890,35 @@ _Class_: Subroutine, function _Syntax_: - `CALL SYMLNK(PATH1, PATH2 [, STATUS])' - `STATUS = SYMLNK(PATH1, PATH2)' + 'CALL SYMLNK(PATH1, PATH2 [, STATUS])' + 'STATUS = SYMLNK(PATH1, PATH2)' _Arguments_: - PATH1 Shall be of default `CHARACTER' type. - PATH2 Shall be of default `CHARACTER' type. - STATUS (Optional) Shall be of default `INTEGER' type. + PATH1 Shall be of default 'CHARACTER' type. + PATH2 Shall be of default 'CHARACTER' type. + STATUS (Optional) Shall be of default 'INTEGER' type. _See also_: *note LINK::, *note UNLINK:: - File: gfortran.info, Node: SYSTEM, Next: SYSTEM_CLOCK, Prev: SYMLNK, Up: Intrinsic Procedures -9.253 `SYSTEM' -- Execute a shell command +9.261 'SYSTEM' -- Execute a shell command ========================================= _Description_: - Passes the command COMMAND to a shell (see `system(3)'). If + Passes the command COMMAND to a shell (see 'system(3)'). If argument STATUS is present, it contains the value returned by - `system(3)', which is presumably 0 if the shell command succeeded. + 'system(3)', which is presumably 0 if the shell command succeeded. Note that which shell is used to invoke the command is system-dependent and environment-dependent. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. - Note that the `system' function need not be thread-safe. It is the - responsibility of the user to ensure that `system' is not called + Note that the 'system' function need not be thread-safe. It is the + responsibility of the user to ensure that 'system' is not called concurrently. _Standard_: @@ -16655,12 +17928,12 @@ _Class_: Subroutine, function _Syntax_: - `CALL SYSTEM(COMMAND [, STATUS])' - `STATUS = SYSTEM(COMMAND)' + 'CALL SYSTEM(COMMAND [, STATUS])' + 'STATUS = SYSTEM(COMMAND)' _Arguments_: - COMMAND Shall be of default `CHARACTER' type. - STATUS (Optional) Shall be of default `INTEGER' type. + COMMAND Shall be of default 'CHARACTER' type. + STATUS (Optional) Shall be of default 'INTEGER' type. _See also_: *note EXECUTE_COMMAND_LINE::, which is part of the Fortran 2008 @@ -16669,42 +17942,41 @@ _See also_: File: gfortran.info, Node: SYSTEM_CLOCK, Next: TAN, Prev: SYSTEM, Up: Intrinsic Procedures -9.254 `SYSTEM_CLOCK' -- Time function +9.262 'SYSTEM_CLOCK' -- Time function ===================================== _Description_: - Determines the COUNT of a processor clock since an unspecified - time in the past modulo COUNT_MAX, COUNT_RATE determines the - number of clock ticks per second. If the platform supports a - monotonic clock, that clock is used and can, depending on the - platform clock implementation, provide up to nanosecond - resolution. If a monotonic clock is not available, the - implementation falls back to a realtime clock. + Determines the COUNT of a processor clock since an unspecified time + in the past modulo COUNT_MAX, COUNT_RATE determines the number of + clock ticks per second. If the platform supports a monotonic + clock, that clock is used and can, depending on the platform clock + implementation, provide up to nanosecond resolution. If a + monotonic clock is not available, the implementation falls back to + a realtime clock. COUNT_RATE is system dependent and can vary depending on the kind - of the arguments. For KIND=4 arguments (and smaller integer kinds), - COUNT represents milliseconds, while for KIND=8 arguments (and - larger integer kinds), COUNT typically represents micro- or + of the arguments. For KIND=4 arguments (and smaller integer + kinds), COUNT represents milliseconds, while for KIND=8 arguments + (and larger integer kinds), COUNT typically represents micro- or nanoseconds depending on resolution of the underlying platform - clock. COUNT_MAX usually equals `HUGE(COUNT_MAX)'. Note that the - millisecond resolution of the KIND=4 version implies that the - COUNT will wrap around in roughly 25 days. In order to avoid issues - with the wrap around and for more precise timing, please use the - KIND=8 version. + clock. COUNT_MAX usually equals 'HUGE(COUNT_MAX)'. Note that the + millisecond resolution of the KIND=4 version implies that the COUNT + will wrap around in roughly 25 days. In order to avoid issues with + the wrap around and for more precise timing, please use the KIND=8 + version. If there is no clock, or querying the clock fails, COUNT is set to - `-HUGE(COUNT)', and COUNT_RATE and COUNT_MAX are set to zero. + '-HUGE(COUNT)', and COUNT_RATE and COUNT_MAX are set to zero. When running on a platform using the GNU C library (glibc) version 2.16 or older, or a derivative thereof, the high resolution - monotonic clock is available only when linking with the RT - library. This can be done explicitly by adding the `-lrt' flag - when linking the application, but is also done implicitly when - using OpenMP. - - On the Windows platform, the version with KIND=4 arguments uses - the `GetTickCount' function, whereas the KIND=8 version uses - `QueryPerformanceCounter' and `QueryPerformanceCounterFrequency'. + monotonic clock is available only when linking with the RT library. + This can be done explicitly by adding the '-lrt' flag when linking + the application, but is also done implicitly when using OpenMP. + + On the Windows platform, the version with KIND=4 arguments uses the + 'GetTickCount' function, whereas the KIND=8 version uses + 'QueryPerformanceCounter' and 'QueryPerformanceCounterFrequency'. For more information, and potential caveats, please see the platform documentation. @@ -16715,15 +17987,15 @@ _Class_: Subroutine _Syntax_: - `CALL SYSTEM_CLOCK([COUNT, COUNT_RATE, COUNT_MAX])' + 'CALL SYSTEM_CLOCK([COUNT, COUNT_RATE, COUNT_MAX])' _Arguments_: - COUNT (Optional) shall be a scalar of type `INTEGER' - with `INTENT(OUT)'. - COUNT_RATE (Optional) shall be a scalar of type `INTEGER' - or `REAL', with `INTENT(OUT)'. - COUNT_MAX (Optional) shall be a scalar of type `INTEGER' - with `INTENT(OUT)'. + COUNT (Optional) shall be a scalar of type 'INTEGER' + with 'INTENT(OUT)'. + COUNT_RATE (Optional) shall be a scalar of type 'INTEGER' + or 'REAL', with 'INTENT(OUT)'. + COUNT_MAX (Optional) shall be a scalar of type 'INTEGER' + with 'INTENT(OUT)'. _Example_: PROGRAM test_system_clock @@ -16736,13 +18008,13 @@ _See also_: *note DATE_AND_TIME::, *note CPU_TIME:: -File: gfortran.info, Node: TAN, Next: TANH, Prev: SYSTEM_CLOCK, Up: Intrinsic Procedures +File: gfortran.info, Node: TAN, Next: TAND, Prev: SYSTEM_CLOCK, Up: Intrinsic Procedures -9.255 `TAN' -- Tangent function +9.263 'TAN' -- Tangent function =============================== _Description_: - `TAN(X)' computes the tangent of X. + 'TAN(X)' computes the tangent of X. _Standard_: Fortran 77 and later, for a complex argument Fortran 2008 or later @@ -16751,13 +18023,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = TAN(X)' + 'RESULT = TAN(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: - The return value has same type and kind as X. + The return value has same type and kind as X, and its value is in + radians. _Example_: program test_tan @@ -16766,23 +18039,65 @@ _Example_: end program test_tan _Specific names_: - Name Argument Return type Standard - `TAN(X)' `REAL(4) X' `REAL(4)' Fortran 95 and - later - `DTAN(X)' `REAL(8) X' `REAL(8)' Fortran 95 and - later + Name Argument Return type Standard + 'TAN(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and + later + 'DTAN(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and + later _See also_: - *note ATAN:: + Inverse function: *note ATAN:: Degrees function: *note TAND:: -File: gfortran.info, Node: TANH, Next: THIS_IMAGE, Prev: TAN, Up: Intrinsic Procedures +File: gfortran.info, Node: TAND, Next: TANH, Prev: TAN, Up: Intrinsic Procedures + +9.264 'TAND' -- Tangent function, degrees +========================================= -9.256 `TANH' -- Hyperbolic tangent function +_Description_: + 'TAND(X)' computes the tangent of X in degrees. + + This function is for compatibility only and should be avoided in + favor of standard constructs wherever possible. + +_Standard_: + GNU Extension, enabled with '-fdec-math'. + +_Class_: + Elemental function + +_Syntax_: + 'RESULT = TAND(X)' + +_Arguments_: + X The type shall be 'REAL' or 'COMPLEX'. + +_Return value_: + The return value has same type and kind as X, and its value is in + degrees. + +_Example_: + program test_tand + real(8) :: x = 0.165_8 + x = tand(x) + end program test_tand + +_Specific names_: + Name Argument Return type Standard + 'TAND(X)' 'REAL(4) X' 'REAL(4)' GNU Extension + 'DTAND(X)' 'REAL(8) X' 'REAL(8)' GNU Extension + +_See also_: + Inverse function: *note ATAND:: Radians function: *note TAN:: + + +File: gfortran.info, Node: TANH, Next: THIS_IMAGE, Prev: TAND, Up: Intrinsic Procedures + +9.265 'TANH' -- Hyperbolic tangent function =========================================== _Description_: - `TANH(X)' computes the hyperbolic tangent of X. + 'TANH(X)' computes the hyperbolic tangent of X. _Standard_: Fortran 77 and later, for a complex argument Fortran 2008 or later @@ -16791,15 +18106,15 @@ _Class_: Elemental function _Syntax_: - `X = TANH(X)' + 'X = TANH(X)' _Arguments_: - X The type shall be `REAL' or `COMPLEX'. + X The type shall be 'REAL' or 'COMPLEX'. _Return value_: - The return value has same type and kind as X. If X is complex, the - imaginary part of the result is in radians. If X is `REAL', the - return value lies in the range - 1 \leq tanh(x) \leq 1 . + The return value has same type and kind as X. If X is complex, the + imaginary part of the result is in radians. If X is 'REAL', the + return value lies in the range - 1 \leq tanh(x) \leq 1 . _Example_: program test_tanh @@ -16808,11 +18123,11 @@ _Example_: end program test_tanh _Specific names_: - Name Argument Return type Standard - `TANH(X)' `REAL(4) X' `REAL(4)' Fortran 95 and - later - `DTANH(X)' `REAL(8) X' `REAL(8)' Fortran 95 and - later + Name Argument Return type Standard + 'TANH(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and + later + 'DTANH(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and + later _See also_: *note ATANH:: @@ -16820,46 +18135,46 @@ _See also_: File: gfortran.info, Node: THIS_IMAGE, Next: TIME, Prev: TANH, Up: Intrinsic Procedures -9.257 `THIS_IMAGE' -- Function that returns the cosubscript index of this image +9.266 'THIS_IMAGE' -- Function that returns the cosubscript index of this image =============================================================================== _Description_: Returns the cosubscript for this image. _Standard_: - Fortran 2008 and later. With DISTANCE argument, Technical + Fortran 2008 and later. With DISTANCE argument, Technical Specification (TS) 18508 or later _Class_: Transformational function _Syntax_: - `RESULT = THIS_IMAGE()' - `RESULT = THIS_IMAGE(DISTANCE)' - `RESULT = THIS_IMAGE(COARRAY [, DIM])' + 'RESULT = THIS_IMAGE()' + 'RESULT = THIS_IMAGE(DISTANCE)' + 'RESULT = THIS_IMAGE(COARRAY [, DIM])' _Arguments_: - DISTANCE (optional, intent(in)) Nonnegative scalar - integer (not permitted together with COARRAY). - COARRAY Coarray of any type (optional; if DIM - present, required). - DIM default integer scalar (optional). If present, - DIM shall be between one and the corank of - COARRAY. + DISTANCE (optional, intent(in)) Nonnegative scalar + integer (not permitted together with COARRAY). + COARRAY Coarray of any type (optional; if DIM present, + required). + DIM default integer scalar (optional). If present, + DIM shall be between one and the corank of + COARRAY. _Return value_: - Default integer. If COARRAY is not present, it is scalar; if + Default integer. If COARRAY is not present, it is scalar; if DISTANCE is not present or has value 0, its value is the image index on the invoking image for the current team, for values - smaller or equal distance to the initial team, it returns the - image index on the ancestor team which has a distance of DISTANCE - from the invoking team. If DISTANCE is larger than the distance to - the initial team, the image index of the initial team is returned. + smaller or equal distance to the initial team, it returns the image + index on the ancestor team which has a distance of DISTANCE from + the invoking team. If DISTANCE is larger than the distance to the + initial team, the image index of the initial team is returned. Otherwise when the COARRAY is present, if DIM is not present, a rank-1 array with corank elements is returned, containing the - cosubscripts for COARRAY specifying the invoking image. If DIM is - present, a scalar is returned, with the value of the DIM element - of `THIS_IMAGE(COARRAY)'. + cosubscripts for COARRAY specifying the invoking image. If DIM is + present, a scalar is returned, with the value of the DIM element of + 'THIS_IMAGE(COARRAY)'. _Example_: INTEGER :: value[*] @@ -16882,16 +18197,17 @@ _See also_: File: gfortran.info, Node: TIME, Next: TIME8, Prev: THIS_IMAGE, Up: Intrinsic Procedures -9.258 `TIME' -- Time function +9.267 'TIME' -- Time function ============================= _Description_: Returns the current time encoded as an integer (in the manner of - the function `time(3)' in the C standard library). This value is - suitable for passing to `CTIME', `GMTIME', and `LTIME'. + the function 'time(3)' in the C standard library). This value is + suitable for passing to *note CTIME::, *note GMTIME::, and *note + LTIME::. This intrinsic is not fully portable, such as to systems with - 32-bit `INTEGER' types but supporting times wider than 32 bits. + 32-bit 'INTEGER' types but supporting times wider than 32 bits. Therefore, the values returned by this intrinsic might be, or become, negative, or numerically less than previous values, during a single run of the compiled program. @@ -16907,32 +18223,32 @@ _Class_: Function _Syntax_: - `RESULT = TIME()' + 'RESULT = TIME()' _Return value_: - The return value is a scalar of type `INTEGER(4)'. + The return value is a scalar of type 'INTEGER(4)'. _See also_: - *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::, - *note TIME8:: - + *note DATE_AND_TIME::, *note CTIME::, *note GMTIME::, *note + LTIME::, *note MCLOCK::, *note TIME8:: File: gfortran.info, Node: TIME8, Next: TINY, Prev: TIME, Up: Intrinsic Procedures -9.259 `TIME8' -- Time function (64-bit) +9.268 'TIME8' -- Time function (64-bit) ======================================= _Description_: Returns the current time encoded as an integer (in the manner of - the function `time(3)' in the C standard library). This value is - suitable for passing to `CTIME', `GMTIME', and `LTIME'. + the function 'time(3)' in the C standard library). This value is + suitable for passing to *note CTIME::, *note GMTIME::, and *note + LTIME::. _Warning:_ this intrinsic does not increase the range of the timing - values over that returned by `time(3)'. On a system with a 32-bit - `time(3)', `TIME8' will return a 32-bit value, even though it is - converted to a 64-bit `INTEGER(8)' value. That means overflows of - the 32-bit value can still occur. Therefore, the values returned + values over that returned by 'time(3)'. On a system with a 32-bit + 'time(3)', 'TIME8' will return a 32-bit value, even though it is + converted to a 64-bit 'INTEGER(8)' value. That means overflows of + the 32-bit value can still occur. Therefore, the values returned by this intrinsic might be or become negative or numerically less than previous values during a single run of the compiled program. @@ -16943,25 +18259,24 @@ _Class_: Function _Syntax_: - `RESULT = TIME8()' + 'RESULT = TIME8()' _Return value_: - The return value is a scalar of type `INTEGER(8)'. + The return value is a scalar of type 'INTEGER(8)'. _See also_: - *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK8::, - *note TIME:: - + *note DATE_AND_TIME::, *note CTIME::, *note GMTIME::, *note + LTIME::, *note MCLOCK8::, *note TIME:: File: gfortran.info, Node: TINY, Next: TRAILZ, Prev: TIME8, Up: Intrinsic Procedures -9.260 `TINY' -- Smallest positive number of a real kind +9.269 'TINY' -- Smallest positive number of a real kind ======================================================= _Description_: - `TINY(X)' returns the smallest positive (non zero) number in the - model of the type of `X'. + 'TINY(X)' returns the smallest positive (non zero) number in the + model of the type of 'X'. _Standard_: Fortran 95 and later @@ -16970,25 +18285,25 @@ _Class_: Inquiry function _Syntax_: - `RESULT = TINY(X)' + 'RESULT = TINY(X)' _Arguments_: - X Shall be of type `REAL'. + X Shall be of type 'REAL'. _Return value_: The return value is of the same type and kind as X _Example_: - See `HUGE' for an example. + See 'HUGE' for an example. File: gfortran.info, Node: TRAILZ, Next: TRANSFER, Prev: TINY, Up: Intrinsic Procedures -9.261 `TRAILZ' -- Number of trailing zero bits of an integer +9.270 'TRAILZ' -- Number of trailing zero bits of an integer ============================================================ _Description_: - `TRAILZ' returns the number of trailing zero bits of an integer. + 'TRAILZ' returns the number of trailing zero bits of an integer. _Standard_: Fortran 2008 and later @@ -16997,14 +18312,14 @@ _Class_: Elemental function _Syntax_: - `RESULT = TRAILZ(I)' + 'RESULT = TRAILZ(I)' _Arguments_: - I Shall be of type `INTEGER'. + I Shall be of type 'INTEGER'. _Return value_: - The type of the return value is the default `INTEGER'. If all the - bits of `I' are zero, the result value is `BIT_SIZE(I)'. + The type of the return value is the default 'INTEGER'. If all the + bits of 'I' are zero, the result value is 'BIT_SIZE(I)'. _Example_: PROGRAM test_trailz @@ -17017,7 +18332,7 @@ _See also_: File: gfortran.info, Node: TRANSFER, Next: TRANSPOSE, Prev: TRAILZ, Up: Intrinsic Procedures -9.262 `TRANSFER' -- Transfer bit patterns +9.271 'TRANSFER' -- Transfer bit patterns ========================================= _Description_: @@ -17035,12 +18350,12 @@ _Class_: Transformational function _Syntax_: - `RESULT = TRANSFER(SOURCE, MOLD[, SIZE])' + 'RESULT = TRANSFER(SOURCE, MOLD[, SIZE])' _Arguments_: - SOURCE Shall be a scalar or an array of any type. - MOLD Shall be a scalar or an array of any type. - SIZE (Optional) shall be a scalar of type `INTEGER'. + SOURCE Shall be a scalar or an array of any type. + MOLD Shall be a scalar or an array of any type. + SIZE (Optional) shall be a scalar of type 'INTEGER'. _Return value_: The result has the same type as MOLD, with the bit level @@ -17048,7 +18363,7 @@ _Return value_: one-dimensional array of length SIZE. If SIZE is absent but MOLD is an array (of any size or shape), the result is a one- dimensional array of the minimum length needed to contain the - entirety of the bitwise representation of SOURCE. If SIZE is + entirety of the bitwise representation of SOURCE. If SIZE is absent and MOLD is a scalar, the result is a scalar. If the bitwise representation of the result is longer than that of @@ -17058,9 +18373,9 @@ _Return value_: When the resulting bit representation does not correspond to a valid representation of a variable of the same type as MOLD, the results are undefined, and subsequent operations on the result - cannot be guaranteed to produce sensible behavior. For example, - it is possible to create `LOGICAL' variables for which `VAR' and - `.NOT.VAR' both appear to be true. + cannot be guaranteed to produce sensible behavior. For example, it + is possible to create 'LOGICAL' variables for which 'VAR' and + '.NOT.VAR' both appear to be true. _Example_: PROGRAM test_transfer @@ -17071,12 +18386,12 @@ _Example_: File: gfortran.info, Node: TRANSPOSE, Next: TRIM, Prev: TRANSFER, Up: Intrinsic Procedures -9.263 `TRANSPOSE' -- Transpose an array of rank two +9.272 'TRANSPOSE' -- Transpose an array of rank two =================================================== _Description_: - Transpose an array of rank two. Element (i, j) of the result has - the value `MATRIX(j, i)', for all i, j. + Transpose an array of rank two. Element (i, j) of the result has + the value 'MATRIX(j, i)', for all i, j. _Standard_: Fortran 95 and later @@ -17085,20 +18400,20 @@ _Class_: Transformational function _Syntax_: - `RESULT = TRANSPOSE(MATRIX)' + 'RESULT = TRANSPOSE(MATRIX)' _Arguments_: - MATRIX Shall be an array of any type and have a rank - of two. + MATRIX Shall be an array of any type and have a rank of + two. _Return value_: - The result has the same type as MATRIX, and has shape `(/ m, n /)' - if MATRIX has shape `(/ n, m /)'. + The result has the same type as MATRIX, and has shape '(/ m, n /)' + if MATRIX has shape '(/ n, m /)'. File: gfortran.info, Node: TRIM, Next: TTYNAM, Prev: TRANSPOSE, Up: Intrinsic Procedures -9.264 `TRIM' -- Remove trailing blank characters of a string +9.273 'TRIM' -- Remove trailing blank characters of a string ============================================================ _Description_: @@ -17111,13 +18426,13 @@ _Class_: Transformational function _Syntax_: - `RESULT = TRIM(STRING)' + 'RESULT = TRIM(STRING)' _Arguments_: - STRING Shall be a scalar of type `CHARACTER'. + STRING Shall be a scalar of type 'CHARACTER'. _Return value_: - A scalar of type `CHARACTER' which length is that of STRING less + A scalar of type 'CHARACTER' which length is that of STRING less the number of trailing blanks. _Example_: @@ -17132,12 +18447,12 @@ _See also_: File: gfortran.info, Node: TTYNAM, Next: UBOUND, Prev: TRIM, Up: Intrinsic Procedures -9.265 `TTYNAM' -- Get the name of a terminal device. +9.274 'TTYNAM' -- Get the name of a terminal device. ==================================================== _Description_: - Get the name of a terminal device. For more information, see - `ttyname(3)'. + Get the name of a terminal device. For more information, see + 'ttyname(3)'. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -17149,12 +18464,12 @@ _Class_: Subroutine, function _Syntax_: - `CALL TTYNAM(UNIT, NAME)' - `NAME = TTYNAM(UNIT)' + 'CALL TTYNAM(UNIT, NAME)' + 'NAME = TTYNAM(UNIT)' _Arguments_: - UNIT Shall be a scalar `INTEGER'. - NAME Shall be of type `CHARACTER'. + UNIT Shall be a scalar 'INTEGER'. + NAME Shall be of type 'CHARACTER'. _Example_: PROGRAM test_ttynam @@ -17170,13 +18485,12 @@ _See also_: File: gfortran.info, Node: UBOUND, Next: UCOBOUND, Prev: TTYNAM, Up: Intrinsic Procedures -9.266 `UBOUND' -- Upper dimension bounds of an array +9.275 'UBOUND' -- Upper dimension bounds of an array ==================================================== _Description_: - Returns the upper bounds of an array, or a single upper bound - along the DIM dimension. - + Returns the upper bounds of an array, or a single upper bound along + the DIM dimension. _Standard_: Fortran 95 and later, with KIND argument Fortran 2003 and later @@ -17184,25 +18498,24 @@ _Class_: Inquiry function _Syntax_: - `RESULT = UBOUND(ARRAY [, DIM [, KIND]])' + 'RESULT = UBOUND(ARRAY [, DIM [, KIND]])' _Arguments_: - ARRAY Shall be an array, of any type. - DIM (Optional) Shall be a scalar `INTEGER'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + ARRAY Shall be an array, of any type. + DIM (Optional) Shall be a scalar 'INTEGER'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. If DIM is absent, the result is an array of the upper bounds of ARRAY. If DIM is present, the result is a scalar corresponding to the upper - bound of the array along that dimension. If ARRAY is an - expression rather than a whole array or array structure component, - or if it has a zero extent along the relevant dimension, the upper - bound is taken to be the number of elements along the relevant - dimension. + bound of the array along that dimension. If ARRAY is an expression + rather than a whole array or array structure component, or if it + has a zero extent along the relevant dimension, the upper bound is + taken to be the number of elements along the relevant dimension. _See also_: *note LBOUND::, *note LCOBOUND:: @@ -17210,13 +18523,12 @@ _See also_: File: gfortran.info, Node: UCOBOUND, Next: UMASK, Prev: UBOUND, Up: Intrinsic Procedures -9.267 `UCOBOUND' -- Upper codimension bounds of an array +9.276 'UCOBOUND' -- Upper codimension bounds of an array ======================================================== _Description_: Returns the upper cobounds of a coarray, or a single upper cobound along the DIM codimension. - _Standard_: Fortran 2008 and later @@ -17224,17 +18536,17 @@ _Class_: Inquiry function _Syntax_: - `RESULT = UCOBOUND(COARRAY [, DIM [, KIND]])' + 'RESULT = UCOBOUND(COARRAY [, DIM [, KIND]])' _Arguments_: - ARRAY Shall be an coarray, of any type. - DIM (Optional) Shall be a scalar `INTEGER'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + ARRAY Shall be an coarray, of any type. + DIM (Optional) Shall be a scalar 'INTEGER'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. If DIM is absent, the result is an array of the lower cobounds of COARRAY. If DIM is present, the result is a scalar corresponding to the @@ -17246,13 +18558,13 @@ _See also_: File: gfortran.info, Node: UMASK, Next: UNLINK, Prev: UCOBOUND, Up: Intrinsic Procedures -9.268 `UMASK' -- Set the file creation mask +9.277 'UMASK' -- Set the file creation mask =========================================== _Description_: - Sets the file creation mask to MASK. If called as a function, it - returns the old value. If called as a subroutine and argument OLD - if it is supplied, it is set to the old value. See `umask(2)'. + Sets the file creation mask to MASK. If called as a function, it + returns the old value. If called as a subroutine and argument OLD + if it is supplied, it is set to the old value. See 'umask(2)'. _Standard_: GNU extension @@ -17261,26 +18573,25 @@ _Class_: Subroutine, function _Syntax_: - `CALL UMASK(MASK [, OLD])' - `OLD = UMASK(MASK)' + 'CALL UMASK(MASK [, OLD])' + 'OLD = UMASK(MASK)' _Arguments_: - MASK Shall be a scalar of type `INTEGER'. - OLD (Optional) Shall be a scalar of type `INTEGER'. - + MASK Shall be a scalar of type 'INTEGER'. + OLD (Optional) Shall be a scalar of type 'INTEGER'. File: gfortran.info, Node: UNLINK, Next: UNPACK, Prev: UMASK, Up: Intrinsic Procedures -9.269 `UNLINK' -- Remove a file from the file system +9.278 'UNLINK' -- Remove a file from the file system ==================================================== _Description_: - Unlinks the file PATH. A null character (`CHAR(0)') can be used to - mark the end of the name in PATH; otherwise, trailing blanks in - the file name are ignored. If the STATUS argument is supplied, it + Unlinks the file PATH. A null character ('CHAR(0)') can be used to + mark the end of the name in PATH; otherwise, trailing blanks in the + file name are ignored. If the STATUS argument is supplied, it contains 0 on success or a nonzero error code upon return; see - `unlink(2)'. + 'unlink(2)'. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -17292,12 +18603,12 @@ _Class_: Subroutine, function _Syntax_: - `CALL UNLINK(PATH [, STATUS])' - `STATUS = UNLINK(PATH)' + 'CALL UNLINK(PATH [, STATUS])' + 'STATUS = UNLINK(PATH)' _Arguments_: - PATH Shall be of default `CHARACTER' type. - STATUS (Optional) Shall be of default `INTEGER' type. + PATH Shall be of default 'CHARACTER' type. + STATUS (Optional) Shall be of default 'INTEGER' type. _See also_: *note LINK::, *note SYMLNK:: @@ -17305,7 +18616,7 @@ _See also_: File: gfortran.info, Node: UNPACK, Next: VERIFY, Prev: UNLINK, Up: Intrinsic Procedures -9.270 `UNPACK' -- Unpack an array of rank one into an array +9.279 'UNPACK' -- Unpack an array of rank one into an array =========================================================== _Description_: @@ -17318,18 +18629,18 @@ _Class_: Transformational function _Syntax_: - `RESULT = UNPACK(VECTOR, MASK, FIELD)' + 'RESULT = UNPACK(VECTOR, MASK, FIELD)' _Arguments_: - VECTOR Shall be an array of any type and rank one. It - shall have at least as many elements as MASK - has `TRUE' values. - MASK Shall be an array of type `LOGICAL'. - FIELD Shall be of the same type as VECTOR and have - the same shape as MASK. + VECTOR Shall be an array of any type and rank one. It + shall have at least as many elements as MASK has + 'TRUE' values. + MASK Shall be an array of type 'LOGICAL'. + FIELD Shall be of the same type as VECTOR and have the + same shape as MASK. _Return value_: - The resulting array corresponds to FIELD with `TRUE' elements of + The resulting array corresponds to FIELD with 'TRUE' elements of MASK replaced by values from VECTOR in array element order. _Example_: @@ -17348,17 +18659,17 @@ _See also_: File: gfortran.info, Node: VERIFY, Next: XOR, Prev: UNPACK, Up: Intrinsic Procedures -9.271 `VERIFY' -- Scan a string for characters not a given set +9.280 'VERIFY' -- Scan a string for characters not a given set ============================================================== _Description_: Verifies that all the characters in STRING belong to the set of characters in SET. - If BACK is either absent or equals `FALSE', this function returns + If BACK is either absent or equals 'FALSE', this function returns the position of the leftmost character of STRING that is not in - SET. If BACK equals `TRUE', the rightmost position is returned. If - all characters of STRING are found in SET, the result is zero. + SET. If BACK equals 'TRUE', the rightmost position is returned. + If all characters of STRING are found in SET, the result is zero. _Standard_: Fortran 95 and later, with KIND argument Fortran 2003 and later @@ -17367,18 +18678,18 @@ _Class_: Elemental function _Syntax_: - `RESULT = VERIFY(STRING, SET[, BACK [, KIND]])' + 'RESULT = VERIFY(STRING, SET[, BACK [, KIND]])' _Arguments_: - STRING Shall be of type `CHARACTER'. - SET Shall be of type `CHARACTER'. - BACK (Optional) shall be of type `LOGICAL'. - KIND (Optional) An `INTEGER' initialization - expression indicating the kind parameter of - the result. + STRING Shall be of type 'CHARACTER'. + SET Shall be of type 'CHARACTER'. + BACK (Optional) shall be of type 'LOGICAL'. + KIND (Optional) An 'INTEGER' initialization + expression indicating the kind parameter of the + result. _Return value_: - The return value is of type `INTEGER' and of kind KIND. If KIND is + The return value is of type 'INTEGER' and of kind KIND. If KIND is absent, the return value is of default integer kind. _Example_: @@ -17396,7 +18707,7 @@ _See also_: File: gfortran.info, Node: XOR, Prev: VERIFY, Up: Intrinsic Procedures -9.272 `XOR' -- Bitwise logical exclusive OR +9.281 'XOR' -- Bitwise logical exclusive OR =========================================== _Description_: @@ -17405,7 +18716,7 @@ _Description_: This intrinsic routine is provided for backwards compatibility with GNU Fortran 77. For integer arguments, programmers should consider the use of the *note IEOR:: intrinsic and for logical arguments the - `.NEQV.' operator, which are both defined by the Fortran standard. + '.NEQV.' operator, which are both defined by the Fortran standard. _Standard_: GNU extension @@ -17414,18 +18725,18 @@ _Class_: Function _Syntax_: - `RESULT = XOR(I, J)' + 'RESULT = XOR(I, J)' _Arguments_: - I The type shall be either a scalar `INTEGER' - type or a scalar `LOGICAL' type. - J The type shall be the same as the type of I. + I The type shall be either a scalar 'INTEGER' type + or a scalar 'LOGICAL' type. + J The type shall be the same as the type of I. _Return value_: - The return type is either a scalar `INTEGER' or a scalar - `LOGICAL'. If the kind type parameters differ, then the smaller - kind type is implicitly converted to larger kind, and the return - has the larger kind. + The return type is either a scalar 'INTEGER' or a scalar 'LOGICAL'. + If the kind type parameters differ, then the smaller kind type is + implicitly converted to larger kind, and the return has the larger + kind. _Example_: PROGRAM test_xor @@ -17457,121 +18768,121 @@ File: gfortran.info, Node: Intrinsic Modules, Next: Contributing, Prev: Intri File: gfortran.info, Node: ISO_FORTRAN_ENV, Next: ISO_C_BINDING, Up: Intrinsic Modules -10.1 `ISO_FORTRAN_ENV' +10.1 'ISO_FORTRAN_ENV' ====================== _Standard_: Fortran 2003 and later, except when otherwise noted - The `ISO_FORTRAN_ENV' module provides the following scalar + The 'ISO_FORTRAN_ENV' module provides the following scalar default-integer named constants: -`ATOMIC_INT_KIND': +'ATOMIC_INT_KIND': Default-kind integer constant to be used as kind parameter when - defining integer variables used in atomic operations. (Fortran + defining integer variables used in atomic operations. (Fortran 2008 or later.) -`ATOMIC_LOGICAL_KIND': +'ATOMIC_LOGICAL_KIND': Default-kind integer constant to be used as kind parameter when - defining logical variables used in atomic operations. (Fortran + defining logical variables used in atomic operations. (Fortran 2008 or later.) -`CHARACTER_KINDS': +'CHARACTER_KINDS': Default-kind integer constant array of rank one containing the - supported kind parameters of the `CHARACTER' type. (Fortran 2008 + supported kind parameters of the 'CHARACTER' type. (Fortran 2008 or later.) -`CHARACTER_STORAGE_SIZE': +'CHARACTER_STORAGE_SIZE': Size in bits of the character storage unit. -`ERROR_UNIT': +'ERROR_UNIT': Identifies the preconnected unit used for error reporting. -`FILE_STORAGE_SIZE': +'FILE_STORAGE_SIZE': Size in bits of the file-storage unit. -`INPUT_UNIT': - Identifies the preconnected unit identified by the asterisk (`*') - in `READ' statement. +'INPUT_UNIT': + Identifies the preconnected unit identified by the asterisk ('*') + in 'READ' statement. -`INT8', `INT16', `INT32', `INT64': - Kind type parameters to specify an INTEGER type with a storage - size of 16, 32, and 64 bits. It is negative if a target platform - does not support the particular kind. (Fortran 2008 or later.) +'INT8', 'INT16', 'INT32', 'INT64': + Kind type parameters to specify an INTEGER type with a storage size + of 16, 32, and 64 bits. It is negative if a target platform does + not support the particular kind. (Fortran 2008 or later.) -`INTEGER_KINDS': +'INTEGER_KINDS': Default-kind integer constant array of rank one containing the - supported kind parameters of the `INTEGER' type. (Fortran 2008 or + supported kind parameters of the 'INTEGER' type. (Fortran 2008 or later.) -`IOSTAT_END': - The value assigned to the variable passed to the `IOSTAT=' +'IOSTAT_END': + The value assigned to the variable passed to the 'IOSTAT=' specifier of an input/output statement if an end-of-file condition occurred. -`IOSTAT_EOR': - The value assigned to the variable passed to the `IOSTAT=' +'IOSTAT_EOR': + The value assigned to the variable passed to the 'IOSTAT=' specifier of an input/output statement if an end-of-record condition occurred. -`IOSTAT_INQUIRE_INTERNAL_UNIT': - Scalar default-integer constant, used by `INQUIRE' for the - `IOSTAT=' specifier to denote an that a unit number identifies an - internal unit. (Fortran 2008 or later.) +'IOSTAT_INQUIRE_INTERNAL_UNIT': + Scalar default-integer constant, used by 'INQUIRE' for the + 'IOSTAT=' specifier to denote an that a unit number identifies an + internal unit. (Fortran 2008 or later.) -`NUMERIC_STORAGE_SIZE': +'NUMERIC_STORAGE_SIZE': The size in bits of the numeric storage unit. -`LOGICAL_KINDS': +'LOGICAL_KINDS': Default-kind integer constant array of rank one containing the - supported kind parameters of the `LOGICAL' type. (Fortran 2008 or + supported kind parameters of the 'LOGICAL' type. (Fortran 2008 or later.) -`OUTPUT_UNIT': - Identifies the preconnected unit identified by the asterisk (`*') - in `WRITE' statement. +'OUTPUT_UNIT': + Identifies the preconnected unit identified by the asterisk ('*') + in 'WRITE' statement. -`REAL32', `REAL64', `REAL128': +'REAL32', 'REAL64', 'REAL128': Kind type parameters to specify a REAL type with a storage size of - 32, 64, and 128 bits. It is negative if a target platform does not - support the particular kind. (Fortran 2008 or later.) + 32, 64, and 128 bits. It is negative if a target platform does not + support the particular kind. (Fortran 2008 or later.) -`REAL_KINDS': +'REAL_KINDS': Default-kind integer constant array of rank one containing the - supported kind parameters of the `REAL' type. (Fortran 2008 or + supported kind parameters of the 'REAL' type. (Fortran 2008 or later.) -`STAT_LOCKED': +'STAT_LOCKED': Scalar default-integer constant used as STAT= return value by - `LOCK' to denote that the lock variable is locked by the executing - image. (Fortran 2008 or later.) + 'LOCK' to denote that the lock variable is locked by the executing + image. (Fortran 2008 or later.) -`STAT_LOCKED_OTHER_IMAGE': +'STAT_LOCKED_OTHER_IMAGE': Scalar default-integer constant used as STAT= return value by - `UNLOCK' to denote that the lock variable is locked by another - image. (Fortran 2008 or later.) + 'UNLOCK' to denote that the lock variable is locked by another + image. (Fortran 2008 or later.) -`STAT_STOPPED_IMAGE': +'STAT_STOPPED_IMAGE': Positive, scalar default-integer constant used as STAT= return value if the argument in the statement requires synchronisation with an image, which has initiated the termination of the - execution. (Fortran 2008 or later.) + execution. (Fortran 2008 or later.) -`STAT_FAILED_IMAGE': +'STAT_FAILED_IMAGE': Positive, scalar default-integer constant used as STAT= return value if the argument in the statement requires communication with - an image, which has is in the failed state. (TS 18508 or later.) + an image, which has is in the failed state. (TS 18508 or later.) -`STAT_UNLOCKED': +'STAT_UNLOCKED': Scalar default-integer constant used as STAT= return value by - `UNLOCK' to denote that the lock variable is unlocked. (Fortran + 'UNLOCK' to denote that the lock variable is unlocked. (Fortran 2008 or later.) The module provides the following derived type: -`LOCK_TYPE': - Derived type with private components to be use with the `LOCK' and - `UNLOCK' statement. A variable of its type has to be always +'LOCK_TYPE': + Derived type with private components to be use with the 'LOCK' and + 'UNLOCK' statement. A variable of its type has to be always declared as coarray and may not appear in a variable-definition context. (Fortran 2008 or later.) @@ -17581,7 +18892,7 @@ COMPILER_OPTIONS:: and *note COMPILER_VERSION::. File: gfortran.info, Node: ISO_C_BINDING, Next: IEEE modules, Prev: ISO_FORTRAN_ENV, Up: Intrinsic Modules -10.2 `ISO_C_BINDING' +10.2 'ISO_C_BINDING' ==================== _Standard_: @@ -17591,198 +18902,180 @@ _Standard_: definition can be found in the section Intrinsic Procedures of this manual. -`C_ASSOCIATED' - -`C_F_POINTER' +'C_ASSOCIATED' +'C_F_POINTER' +'C_F_PROCPOINTER' +'C_FUNLOC' +'C_LOC' +'C_SIZEOF' -`C_F_PROCPOINTER' - -`C_FUNLOC' - -`C_LOC' - -`C_SIZEOF' - - The `ISO_C_BINDING' module provides the following named constants of + The 'ISO_C_BINDING' module provides the following named constants of type default integer, which can be used as KIND type parameters. In addition to the integer named constants required by the Fortran -2003 standard and `C_PTRDIFF_T' of TS 29113, GNU Fortran provides as an +2003 standard and 'C_PTRDIFF_T' of TS 29113, GNU Fortran provides as an extension named constants for the 128-bit integer types supported by the -C compiler: `C_INT128_T, C_INT_LEAST128_T, C_INT_FAST128_T'. -Furthermore, if `__float128' is supported in C, the named constants -`C_FLOAT128, C_FLOAT128_COMPLEX' are defined. +C compiler: 'C_INT128_T, C_INT_LEAST128_T, C_INT_FAST128_T'. +Furthermore, if '__float128' is supported in C, the named constants +'C_FLOAT128, C_FLOAT128_COMPLEX' are defined. Fortran Named constant C type Extension -Type -`INTEGER' `C_INT' `int' -`INTEGER' `C_SHORT' `short int' -`INTEGER' `C_LONG' `long int' -`INTEGER' `C_LONG_LONG' `long long int' -`INTEGER' `C_SIGNED_CHAR' `signed char'/`unsigned - char' -`INTEGER' `C_SIZE_T' `size_t' -`INTEGER' `C_INT8_T' `int8_t' -`INTEGER' `C_INT16_T' `int16_t' -`INTEGER' `C_INT32_T' `int32_t' -`INTEGER' `C_INT64_T' `int64_t' -`INTEGER' `C_INT128_T' `int128_t' Ext. -`INTEGER' `C_INT_LEAST8_T' `int_least8_t' -`INTEGER' `C_INT_LEAST16_T' `int_least16_t' -`INTEGER' `C_INT_LEAST32_T' `int_least32_t' -`INTEGER' `C_INT_LEAST64_T' `int_least64_t' -`INTEGER' `C_INT_LEAST128_T' `int_least128_t' Ext. -`INTEGER' `C_INT_FAST8_T' `int_fast8_t' -`INTEGER' `C_INT_FAST16_T' `int_fast16_t' -`INTEGER' `C_INT_FAST32_T' `int_fast32_t' -`INTEGER' `C_INT_FAST64_T' `int_fast64_t' -`INTEGER' `C_INT_FAST128_T' `int_fast128_t' Ext. -`INTEGER' `C_INTMAX_T' `intmax_t' -`INTEGER' `C_INTPTR_T' `intptr_t' -`INTEGER' `C_PTRDIFF_T' `intptr_t' TS 29113 -`REAL' `C_FLOAT' `float' -`REAL' `C_DOUBLE' `double' -`REAL' `C_LONG_DOUBLE' `long double' -`REAL' `C_FLOAT128' `__float128' Ext. -`COMPLEX' `C_FLOAT_COMPLEX' `float _Complex' -`COMPLEX' `C_DOUBLE_COMPLEX' `double _Complex' -`COMPLEX' `C_LONG_DOUBLE_COMPLEX' `long double _Complex' -`REAL' `C_FLOAT128_COMPLEX' `__float128 _Complex' Ext. -`LOGICAL' `C_BOOL' `_Bool' -`CHARACTER' `C_CHAR' `char' +Type +'INTEGER' 'C_INT' 'int' +'INTEGER' 'C_SHORT' 'short int' +'INTEGER' 'C_LONG' 'long int' +'INTEGER' 'C_LONG_LONG' 'long long int' +'INTEGER' 'C_SIGNED_CHAR' 'signed char'/'unsigned + char' +'INTEGER' 'C_SIZE_T' 'size_t' +'INTEGER' 'C_INT8_T' 'int8_t' +'INTEGER' 'C_INT16_T' 'int16_t' +'INTEGER' 'C_INT32_T' 'int32_t' +'INTEGER' 'C_INT64_T' 'int64_t' +'INTEGER' 'C_INT128_T' 'int128_t' Ext. +'INTEGER' 'C_INT_LEAST8_T' 'int_least8_t' +'INTEGER' 'C_INT_LEAST16_T' 'int_least16_t' +'INTEGER' 'C_INT_LEAST32_T' 'int_least32_t' +'INTEGER' 'C_INT_LEAST64_T' 'int_least64_t' +'INTEGER' 'C_INT_LEAST128_T' 'int_least128_t' Ext. +'INTEGER' 'C_INT_FAST8_T' 'int_fast8_t' +'INTEGER' 'C_INT_FAST16_T' 'int_fast16_t' +'INTEGER' 'C_INT_FAST32_T' 'int_fast32_t' +'INTEGER' 'C_INT_FAST64_T' 'int_fast64_t' +'INTEGER' 'C_INT_FAST128_T' 'int_fast128_t' Ext. +'INTEGER' 'C_INTMAX_T' 'intmax_t' +'INTEGER' 'C_INTPTR_T' 'intptr_t' +'INTEGER' 'C_PTRDIFF_T' 'ptrdiff_t' TS 29113 +'REAL' 'C_FLOAT' 'float' +'REAL' 'C_DOUBLE' 'double' +'REAL' 'C_LONG_DOUBLE' 'long double' +'REAL' 'C_FLOAT128' '__float128' Ext. +'COMPLEX' 'C_FLOAT_COMPLEX' 'float _Complex' +'COMPLEX' 'C_DOUBLE_COMPLEX' 'double _Complex' +'COMPLEX' 'C_LONG_DOUBLE_COMPLEX' 'long double _Complex' +'REAL' 'C_FLOAT128_COMPLEX' '__float128 _Complex' Ext. +'LOGICAL' 'C_BOOL' '_Bool' +'CHARACTER' 'C_CHAR' 'char' Additionally, the following parameters of type -`CHARACTER(KIND=C_CHAR)' are defined. +'CHARACTER(KIND=C_CHAR)' are defined. Name C definition Value -`C_NULL_CHAR' null character `'\0'' -`C_ALERT' alert `'\a'' -`C_BACKSPACE' backspace `'\b'' -`C_FORM_FEED' form feed `'\f'' -`C_NEW_LINE' new line `'\n'' -`C_CARRIAGE_RETURN'carriage return `'\r'' -`C_HORIZONTAL_TAB'horizontal tab `'\t'' -`C_VERTICAL_TAB'vertical tab `'\v'' +'C_NULL_CHAR' null character ''\0'' +'C_ALERT' alert ''\a'' +'C_BACKSPACE' backspace ''\b'' +'C_FORM_FEED' form feed ''\f'' +'C_NEW_LINE' new line ''\n'' +'C_CARRIAGE_RETURN'carriage return ''\r'' +'C_HORIZONTAL_TAB'horizontal tab ''\t'' +'C_VERTICAL_TAB'vertical tab ''\v'' Moreover, the following two named constants are defined: Name Type -`C_NULL_PTR' `C_PTR' -`C_NULL_FUNPTR'`C_FUNPTR' +'C_NULL_PTR' 'C_PTR' +'C_NULL_FUNPTR''C_FUNPTR' - Both are equivalent to the value `NULL' in C. + Both are equivalent to the value 'NULL' in C. File: gfortran.info, Node: IEEE modules, Next: OpenMP Modules OMP_LIB and OMP_LIB_KINDS, Prev: ISO_C_BINDING, Up: Intrinsic Modules -10.3 IEEE modules: `IEEE_EXCEPTIONS', `IEEE_ARITHMETIC', and `IEEE_FEATURES' +10.3 IEEE modules: 'IEEE_EXCEPTIONS', 'IEEE_ARITHMETIC', and 'IEEE_FEATURES' ============================================================================ _Standard_: Fortran 2003 and later - The `IEEE_EXCEPTIONS', `IEEE_ARITHMETIC', and `IEEE_FEATURES' + The 'IEEE_EXCEPTIONS', 'IEEE_ARITHMETIC', and 'IEEE_FEATURES' intrinsic modules provide support for exceptions and IEEE arithmetic, as defined in Fortran 2003 and later standards, and the IEC 60559:1989 standard (_Binary floating-point arithmetic for microprocessor -systems_). These modules are only provided on the following supported +systems_). These modules are only provided on the following supported platforms: * i386 and x86_64 processors - * platforms which use the GNU C Library (glibc) - * platforms with support for SysV/386 routines for floating point interface (including Solaris and BSDs) - * platforms with the AIX OS For full compliance with the Fortran standards, code using the -`IEEE_EXCEPTIONS' or `IEEE_ARITHMETIC' modules should be compiled with -the following options: `-fno-unsafe-math-optimizations -frounding-math +'IEEE_EXCEPTIONS' or 'IEEE_ARITHMETIC' modules should be compiled with +the following options: '-fno-unsafe-math-optimizations -frounding-math -fsignaling-nans'. File: gfortran.info, Node: OpenMP Modules OMP_LIB and OMP_LIB_KINDS, Next: OpenACC Module OPENACC, Prev: IEEE modules, Up: Intrinsic Modules -10.4 OpenMP Modules `OMP_LIB' and `OMP_LIB_KINDS' +10.4 OpenMP Modules 'OMP_LIB' and 'OMP_LIB_KINDS' ================================================= _Standard_: - OpenMP Application Program Interface v4.0 + OpenMP Application Program Interface v4.5 The OpenMP Fortran runtime library routines are provided both in a -form of two Fortran 90 modules, named `OMP_LIB' and `OMP_LIB_KINDS', -and in a form of a Fortran `include' file named `omp_lib.h'. The -procedures provided by `OMP_LIB' can be found in the *note -Introduction: (libgomp)Top. manual, the named constants defined in the -modules are listed below. +form of two Fortran 90 modules, named 'OMP_LIB' and 'OMP_LIB_KINDS', and +in a form of a Fortran 'include' file named 'omp_lib.h'. The procedures +provided by 'OMP_LIB' can be found in the *note Introduction: +(libgomp)Top. manual, the named constants defined in the modules are +listed below. For details refer to the actual OpenMP Application Program Interface -v4.0 (http://www.openmp.org/mp-documents/OpenMP4.0.0.pdf). +v4.5 (http://www.openmp.org/wp-content/uploads/openmp-4.5.pdf). - `OMP_LIB_KINDS' provides the following scalar default-integer named + 'OMP_LIB_KINDS' provides the following scalar default-integer named constants: -`omp_lock_kind' +'omp_lock_kind' +'omp_nest_lock_kind' +'omp_proc_bind_kind' +'omp_sched_kind' -`omp_nest_lock_kind' - -`omp_proc_bind_kind' - -`omp_sched_kind' - - `OMP_LIB' provides the scalar default-integer named constant -`openmp_version' with a value of the form YYYYMM, where `yyyy' is the -year and MM the month of the OpenMP version; for OpenMP v4.0 the value -is `201307'. + 'OMP_LIB' provides the scalar default-integer named constant +'openmp_version' with a value of the form YYYYMM, where 'yyyy' is the +year and MM the month of the OpenMP version; for OpenMP v4.5 the value +is '201511'. The following scalar integer named constants of the kind -`omp_sched_kind': - -`omp_sched_static' +'omp_sched_kind': -`omp_sched_dynamic' - -`omp_sched_guided' - -`omp_sched_auto' +'omp_sched_static' +'omp_sched_dynamic' +'omp_sched_guided' +'omp_sched_auto' And the following scalar integer named constants of the kind -`omp_proc_bind_kind': - -`omp_proc_bind_false' - -`omp_proc_bind_true' +'omp_proc_bind_kind': -`omp_proc_bind_master' - -`omp_proc_bind_close' - -`omp_proc_bind_spread' +'omp_proc_bind_false' +'omp_proc_bind_true' +'omp_proc_bind_master' +'omp_proc_bind_close' +'omp_proc_bind_spread' File: gfortran.info, Node: OpenACC Module OPENACC, Prev: OpenMP Modules OMP_LIB and OMP_LIB_KINDS, Up: Intrinsic Modules -10.5 OpenACC Module `OPENACC' +10.5 OpenACC Module 'OPENACC' ============================= _Standard_: OpenACC Application Programming Interface v2.0 The OpenACC Fortran runtime library routines are provided both in a -form of a Fortran 90 module, named `OPENACC', and in form of a Fortran -`include' file named `openacc_lib.h'. The procedures provided by -`OPENACC' can be found in the *note Introduction: (libgomp)Top. manual, +form of a Fortran 90 module, named 'OPENACC', and in form of a Fortran +'include' file named 'openacc_lib.h'. The procedures provided by +'OPENACC' can be found in the *note Introduction: (libgomp)Top. manual, the named constants defined in the modules are listed below. For details refer to the actual OpenACC Application Programming Interface v2.0 (http://www.openacc.org/). - `OPENACC' provides the scalar default-integer named constant -`openacc_version' with a value of the form YYYYMM, where `yyyy' is the -year and MM the month of the OpenACC version; for OpenACC v2.0 the -value is `201306'. + 'OPENACC' provides the scalar default-integer named constant +'openacc_version' with a value of the form YYYYMM, where 'yyyy' is the +year and MM the month of the OpenACC version; for OpenACC v2.0 the value +is '201306'. File: gfortran.info, Node: Contributing, Next: Copying, Prev: Intrinsic Modules, Up: Top @@ -17790,9 +19083,9 @@ File: gfortran.info, Node: Contributing, Next: Copying, Prev: Intrinsic Modul Contributing ************ -Free software is only possible if people contribute to efforts to -create it. We're always in need of more people helping out with ideas -and comments, writing documentation and contributing code. +Free software is only possible if people contribute to efforts to create +it. We're always in need of more people helping out with ideas and +comments, writing documentation and contributing code. If you want to contribute to GNU Fortran, have a look at the long lists of projects you can take on. Some of these projects are small, @@ -17822,69 +19115,37 @@ with GCC was written by _Paul Brook_. significant help to the GNU Fortran project (in alphabetical order): - Janne Blomqvist - - Steven Bosscher - - Paul Brook - - Tobias Burnus - - Franc,ois-Xavier Coudert - - Bud Davis - - Jerry DeLisle - - Erik Edelmann - - Bernhard Fischer - - Daniel Franke - - Richard Guenther - - Richard Henderson - - Katherine Holcomb - - Jakub Jelinek - - Niels Kristian Bech Jensen - - Steven Johnson - - Steven G. Kargl - - Thomas Koenig - - Asher Langton - - H. J. Lu - - Toon Moene - - Brooks Moses - - Andrew Pinski - - Tim Prince - - Christopher D. Rickett - - Richard Sandiford - - Tobias Schlu"ter - - Roger Sayle - - Paul Thomas - - Andy Vaught - - Feng Wang - - Janus Weil - - Daniel Kraft The following people have contributed bug reports, smaller or larger @@ -17892,13 +19153,9 @@ patches, and much needed feedback and encouragement for the GNU Fortran project: - Bill Clodius - - Dominique d'Humie`res - - Kate Hedstrom - - Erik Schnetter - - Joost VandeVondele Many other individuals have helped debug, test and improve the GNU @@ -17914,29 +19171,28 @@ Projects _Help build the test suite_ Solicit more code for donation to the test suite: the more - extensive the testsuite, the smaller the risk of breaking things - in the future! We can keep code private on request. + extensive the testsuite, the smaller the risk of breaking things in + the future! We can keep code private on request. _Bug hunting/squishing_ - Find bugs and write more test cases! Test cases are especially very - welcome, because it allows us to concentrate on fixing bugs + Find bugs and write more test cases! Test cases are especially + very welcome, because it allows us to concentrate on fixing bugs instead of isolating them. Going through the bugzilla database at - `https://gcc.gnu.org/bugzilla/' to reduce testcases posted there + <https://gcc.gnu.org/bugzilla/> to reduce testcases posted there and add more information (for example, for which version does the - testcase work, for which versions does it fail?) is also very + testcase work, for which versions does it fail?) is also very helpful. - File: gfortran.info, Node: Proposed Extensions, Prev: Projects, Up: Contributing 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. +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. Compiler extensions: -------------------- @@ -17945,8 +19201,8 @@ Compiler extensions: * Automatically extend single precision constants to double. - * Compile code that conserves memory by dynamically allocating - common and module storage either on stack or heap. + * Compile code that conserves memory by dynamically allocating common + and module storage either on stack or heap. * Compile flag to generate code for array conformance checking (suggest -CC). @@ -17994,7 +19250,6 @@ Environment Options * Environment variable forcing standard output to be line buffered (Unix). - File: gfortran.info, Node: Copying, Next: GNU Free Documentation License, Prev: Contributing, Up: Top @@ -18003,7 +19258,7 @@ GNU General Public License Version 3, 29 June 2007 - Copyright (C) 2007 Free Software Foundation, Inc. `http://fsf.org/' + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -18031,9 +19286,9 @@ want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you -have certain responsibilities if you distribute copies of the software, -or if you modify it: responsibilities to respect the freedom of others. +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same @@ -18052,16 +19307,15 @@ changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the -manufacturer can do so. This is fundamentally incompatible with the -aim of protecting users' freedom to change the software. The -systematic pattern of such abuse occurs in the area of products for -individuals to use, which is precisely where it is most unacceptable. -Therefore, we have designed this version of the GPL to prohibit the -practice for those products. If such problems arise substantially in -other domains, we stand ready to extend this provision to those domains -in future versions of the GPL, as needed to protect the freedom of -users. +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of @@ -18098,8 +19352,8 @@ TERMS AND CONDITIONS To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for - infringement under applicable copyright law, except executing it - on a computer or modifying a private copy. Propagation includes + infringement under applicable copyright law, except executing it on + a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. @@ -18113,8 +19367,8 @@ TERMS AND CONDITIONS to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to - the extent that warranties are provided), that licensees may - convey the work under this License, and how to view a copy of this + the extent that warranties are provided), that licensees may convey + the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. @@ -18122,8 +19376,8 @@ TERMS AND CONDITIONS 1. Source Code. The "source code" for a work means the preferred form of the work - for making modifications to it. "Object code" means any - non-source form of a work. + for making modifications to it. "Object code" means any non-source + form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in @@ -18134,10 +19388,10 @@ TERMS AND CONDITIONS The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that - Major Component, and (b) serves only to enable use of the work - with that Major Component, or to implement a Standard Interface - for which an implementation is available to the public in source - code form. A "Major Component", in this context, means a major + Major Component, and (b) serves only to enable use of the work with + that Major Component, or to implement a Standard Interface for + which an implementation is available to the public in source code + form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code @@ -18145,15 +19399,15 @@ TERMS AND CONDITIONS The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable - work) run the object code and to modify the work, including - scripts to control those activities. However, it does not include - the work's System Libraries, or general-purpose tools or generally + work) run the object code and to modify the work, including scripts + to control those activities. However, it does not include the + work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, - Corresponding Source includes interface definition files - associated with source files for the work, and the source code for - shared libraries and dynamically linked subprograms that the work - is specifically designed to require, such as by intimate data + Corresponding Source includes interface definition files associated + with source files for the work, and the source code for shared + libraries and dynamically linked subprograms that the work is + specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. @@ -18170,22 +19424,22 @@ TERMS AND CONDITIONS copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running - a covered work is covered by this License only if the output, - given its content, constitutes a covered work. This License - acknowledges your rights of fair use or other equivalent, as - provided by copyright law. + a covered work is covered by this License only if the output, given + its content, constitutes a covered work. This License acknowledges + your rights of fair use or other equivalent, as provided by + copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the - sole purpose of having them make modifications exclusively for - you, or provide you with facilities for running those works, - provided that you comply with the terms of this License in - conveying all material for which you do not control copyright. - Those thus making or running the covered works for you must do so - exclusively on your behalf, under your direction and control, on - terms that prohibit them from making any copies of your - copyrighted material outside their relationship with you. + sole purpose of having them make modifications exclusively for you, + or provide you with facilities for running those works, provided + that you comply with the terms of this License in conveying all + material for which you do not control copyright. Those thus making + or running the covered works for you must do so exclusively on your + behalf, under your direction and control, on terms that prohibit + them from making any copies of your copyrighted material outside + their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section @@ -18202,8 +19456,8 @@ TERMS AND CONDITIONS When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License - with respect to the covered work, and you disclaim any intention - to limit operation or modification of the work as a means of + with respect to the covered work, and you disclaim any intention to + limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. @@ -18273,8 +19527,8 @@ TERMS AND CONDITIONS b. Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for - as long as you offer spare parts or customer support for that + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a @@ -18284,32 +19538,31 @@ TERMS AND CONDITIONS to copy the Corresponding Source from a network server at no charge. - c. Convey individual copies of the object code with a copy of - the written offer to provide the Corresponding Source. This + c. Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d. Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access - to the Corresponding Source in the same way through the same + place (gratis or for a charge), and offer equivalent access to + the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the - Corresponding Source may be on a different server (operated - by you or a third party) that supports equivalent copying - facilities, provided you maintain clear directions next to - the object code saying where to find the Corresponding Source. + Corresponding Source may be on a different server (operated by + you or a third party) that supports equivalent copying + facilities, provided you maintain clear directions next to the + object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you - remain obligated to ensure that it is available for as long - as needed to satisfy these requirements. + remain obligated to ensure that it is available for as long as + needed to satisfy these requirements. e. Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. - A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. @@ -18317,8 +19570,8 @@ TERMS AND CONDITIONS A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for - incorporation into a dwelling. In determining whether a product - is a consumer product, doubtful cases shall be resolved in favor of + incorporation into a dwelling. In determining whether a product is + a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the @@ -18349,11 +19602,11 @@ TERMS AND CONDITIONS The requirement to provide Installation Information does not include a requirement to continue to provide support service, - warranty, or updates for a work that has been modified or - installed by the recipient, or for the User Product in which it - has been modified or installed. Access to a network may be denied - when the modification itself materially and adversely affects the - operation of the network or violates the rules and protocols for + warranty, or updates for a work that has been modified or installed + by the recipient, or for the User Product in which it has been + modified or installed. Access to a network may be denied when the + modification itself materially and adversely affects the operation + of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information @@ -18383,8 +19636,8 @@ TERMS AND CONDITIONS Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright - holders of that material) supplement the terms of this License - with terms: + holders of that material) supplement the terms of this License with + terms: a. Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or @@ -18394,9 +19647,8 @@ TERMS AND CONDITIONS Legal Notices displayed by works containing it; or c. Prohibiting misrepresentation of the origin of that material, - or requiring that modified versions of such material be - marked in reasonable ways as different from the original - version; or + or requiring that modified versions of such material be marked + in reasonable ways as different from the original version; or d. Limiting the use for publicity purposes of names of licensors or authors of the material; or @@ -18415,11 +19667,10 @@ TERMS AND CONDITIONS you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document - contains a further restriction but permits relicensing or - conveying under this License, you may add to a covered work - material governed by the terms of that license document, provided - that the further restriction does not survive such relicensing or - conveying. + contains a further restriction but permits relicensing or conveying + under this License, you may add to a covered work material governed + by the terms of that license document, provided that the further + restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the @@ -18435,13 +19686,13 @@ TERMS AND CONDITIONS You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights - under this License (including any patent licenses granted under - the third paragraph of section 11). + under this License (including any patent licenses granted under the + third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly - and finally terminates your license, and (b) permanently, if the + provisionally, unless and until the copyright holder explicitly and + finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. @@ -18453,10 +19704,10 @@ TERMS AND CONDITIONS after your receipt of the notice. Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from - you under this License. If your rights have been terminated and - not permanently reinstated, you do not qualify to receive new - licenses for the same material under section 10. + the licenses of parties who have received copies or rights from you + under this License. If your rights have been terminated and not + permanently reinstated, you do not qualify to receive new licenses + for the same material under section 10. 9. Acceptance Not Required for Having Copies. @@ -18470,7 +19721,7 @@ TERMS AND CONDITIONS by modifying or propagating a covered work, you indicate your acceptance of this License to do so. - 10. Automatic Licensing of Downstream Recipients. + 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and @@ -18484,21 +19735,21 @@ TERMS AND CONDITIONS covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or - could give under the previous paragraph, plus a right to - possession of the Corresponding Source of the work from the - predecessor in interest, if the predecessor has it or can get it - with reasonable efforts. + could give under the previous paragraph, plus a right to possession + of the Corresponding Source of the work from the predecessor in + interest, if the predecessor has it or can get it with reasonable + efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you - may not impose a license fee, royalty, or other charge for - exercise of rights granted under this License, and you may not - initiate litigation (including a cross-claim or counterclaim in a - lawsuit) alleging that any patent claim is infringed by making, - using, selling, offering for sale, or importing the Program or any - portion of it. + may not impose a license fee, royalty, or other charge for exercise + of rights granted under this License, and you may not initiate + litigation (including a cross-claim or counterclaim in a lawsuit) + alleging that any patent claim is infringed by making, using, + selling, offering for sale, or importing the Program or any portion + of it. - 11. Patents. + 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. @@ -18518,15 +19769,15 @@ TERMS AND CONDITIONS Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and - otherwise run, modify and propagate the contents of its - contributor version. + otherwise run, modify and propagate the contents of its contributor + version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a - patent or covenant not to sue for patent infringement). To - "grant" such a patent license to a party means to make such an - agreement or commitment not to enforce a patent against the party. + patent or covenant not to sue for patent infringement). To "grant" + such a patent license to a party means to make such an agreement or + commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available @@ -18556,36 +19807,35 @@ TERMS AND CONDITIONS conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third - party that is in the business of distributing software, under - which you make payment to the third party based on the extent of - your activity of conveying the work, and under which the third - party grants, to any of the parties who would receive the covered - work from you, a discriminatory patent license (a) in connection - with copies of the covered work conveyed by you (or copies made - from those copies), or (b) primarily for and in connection with - specific products or compilations that contain the covered work, - unless you entered into that arrangement, or that patent license - was granted, prior to 28 March 2007. + party that is in the business of distributing software, under which + you make payment to the third party based on the extent of your + activity of conveying the work, and under which the third party + grants, to any of the parties who would receive the covered work + from you, a discriminatory patent license (a) in connection with + copies of the covered work conveyed by you (or copies made from + those copies), or (b) primarily for and in connection with specific + products or compilations that contain the covered work, unless you + entered into that arrangement, or that patent license was granted, + prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. - 12. No Surrender of Others' Freedom. + 12. No Surrender of Others' Freedom. - If conditions are imposed on you (whether by court order, - agreement or otherwise) that contradict the conditions of this - License, they do not excuse you from the conditions of this - License. If you cannot convey a covered work so as to satisfy - simultaneously your obligations under this License and any other - pertinent obligations, then as a consequence you may not convey it - at all. For example, if you agree to terms that obligate you to - collect a royalty for further conveying from those to whom you - convey the Program, the only way you could satisfy both those - terms and this License would be to refrain entirely from conveying - the Program. + If conditions are imposed on you (whether by court order, agreement + or otherwise) that contradict the conditions of this License, they + do not excuse you from the conditions of this License. If you + cannot convey a covered work so as to satisfy simultaneously your + obligations under this License and any other pertinent obligations, + then as a consequence you may not convey it at all. For example, + if you agree to terms that obligate you to collect a royalty for + further conveying from those to whom you convey the Program, the + only way you could satisfy both those terms and this License would + be to refrain entirely from conveying the Program. - 13. Use with the GNU Affero General Public License. + 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed @@ -18596,22 +19846,21 @@ TERMS AND CONDITIONS General Public License, section 13, concerning interaction through a network will apply to the combination as such. - 14. Revised Versions of this License. + 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new - versions of the GNU General Public License from time to time. - Such new versions will be similar in spirit to the present - version, but may differ in detail to address new problems or - concerns. + versions of the GNU General Public License from time to time. Such + new versions will be similar in spirit to the present version, but + may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of - that numbered version or of any later version published by the - Free Software Foundation. If the Program does not specify a - version number of the GNU General Public License, you may choose - any version ever published by the Free Software Foundation. + that numbered version or of any later version published by the Free + Software Foundation. If the Program does not specify a version + number of the GNU General Public License, you may choose any + version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that @@ -18623,24 +19872,24 @@ TERMS AND CONDITIONS author or copyright holder as a result of your choosing to follow a later version. - 15. Disclaimer of Warranty. + 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY - APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE + APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE + MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - 16. Limitation of Liability. + 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES - AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU - FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR + AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR + DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD @@ -18648,7 +19897,7 @@ TERMS AND CONDITIONS PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. - 17. Interpretation of Sections 15 and 16. + 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, @@ -18657,7 +19906,6 @@ TERMS AND CONDITIONS connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. - END OF TERMS AND CONDITIONS =========================== @@ -18688,7 +19936,7 @@ state the exclusion of warranty; and each file should have at least the General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see `http://www.gnu.org/licenses/'. + along with this program. If not, see <http://www.gnu.org/licenses/>. Also add information on how to contact you by electronic and paper mail. @@ -18697,11 +19945,11 @@ mail. notice like this when it starts in an interactive mode: PROGRAM Copyright (C) YEAR NAME OF AUTHOR - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'. This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. + under certain conditions; type 'show c' for details. - The hypothetical commands `show w' and `show c' should show the + The hypothetical commands 'show w' and 'show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". @@ -18709,14 +19957,14 @@ use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow -the GNU GPL, see `http://www.gnu.org/licenses/'. +the GNU GPL, see <http://www.gnu.org/licenses/>. The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, -please read `http://www.gnu.org/philosophy/why-not-lgpl.html'. +please read <http://www.gnu.org/philosophy/why-not-lgpl.html>. File: gfortran.info, Node: GNU Free Documentation License, Next: Funding, Prev: Copying, Up: Top @@ -18727,7 +19975,7 @@ GNU Free Documentation License Version 1.3, 3 November 2008 Copyright (C) 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. - `http://fsf.org/' + <http://fsf.org/> Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -18752,21 +20000,21 @@ GNU Free Documentation License free program should come with manuals providing the same freedoms that the software does. But this License is not limited to software manuals; it can be used for any textual work, regardless - of subject matter or whether it is published as a printed book. - We recommend this License principally for works whose purpose is + of subject matter or whether it is published as a printed book. We + recommend this License principally for works whose purpose is instruction or reference. 1. APPLICABILITY AND DEFINITIONS This License applies to any manual or other work, in any medium, - that contains a notice placed by the copyright holder saying it - can be distributed under the terms of this License. Such a notice + that contains a notice placed by the copyright holder saying it can + be distributed under the terms of this License. Such a notice grants a world-wide, royalty-free license, unlimited in duration, to use that work under the conditions stated herein. The "Document", below, refers to any such manual or work. Any member - of the public is a licensee, and is addressed as "you". You - accept the license if you copy, modify or distribute the work in a - way requiring permission under copyright law. + of the public is a licensee, and is addressed as "you". You accept + the license if you copy, modify or distribute the work in a way + requiring permission under copyright law. A "Modified Version" of the Document means any work containing the Document or a portion of it, either copied verbatim, or with @@ -18784,12 +20032,12 @@ GNU Free Documentation License regarding them. The "Invariant Sections" are certain Secondary Sections whose - titles are designated, as being those of Invariant Sections, in - the notice that says that the Document is released under this - License. If a section does not fit the above definition of - Secondary then it is not allowed to be designated as Invariant. - The Document may contain zero Invariant Sections. If the Document - does not identify any Invariant Sections then there are none. + titles are designated, as being those of Invariant Sections, in the + notice that says that the Document is released under this License. + If a section does not fit the above definition of Secondary then it + is not allowed to be designated as Invariant. The Document may + contain zero Invariant Sections. If the Document does not identify + any Invariant Sections then there are none. The "Cover Texts" are certain short passages of text that are listed, as Front-Cover Texts or Back-Cover Texts, in the notice @@ -18800,27 +20048,27 @@ GNU Free Documentation License A "Transparent" copy of the Document means a machine-readable copy, represented in a format whose specification is available to the general public, that is suitable for revising the document - straightforwardly with generic text editors or (for images - composed of pixels) generic paint programs or (for drawings) some - widely available drawing editor, and that is suitable for input to - text formatters or for automatic translation to a variety of - formats suitable for input to text formatters. A copy made in an - otherwise Transparent file format whose markup, or absence of - markup, has been arranged to thwart or discourage subsequent - modification by readers is not Transparent. An image format is - not Transparent if used for any substantial amount of text. A - copy that is not "Transparent" is called "Opaque". + straightforwardly with generic text editors or (for images composed + of pixels) generic paint programs or (for drawings) some widely + available drawing editor, and that is suitable for input to text + formatters or for automatic translation to a variety of formats + suitable for input to text formatters. A copy made in an otherwise + Transparent file format whose markup, or absence of markup, has + been arranged to thwart or discourage subsequent modification by + readers is not Transparent. An image format is not Transparent if + used for any substantial amount of text. A copy that is not + "Transparent" is called "Opaque". Examples of suitable formats for Transparent copies include plain ASCII without markup, Texinfo input format, LaTeX input format, - SGML or XML using a publicly available DTD, and - standard-conforming simple HTML, PostScript or PDF designed for - human modification. Examples of transparent image formats include - PNG, XCF and JPG. Opaque formats include proprietary formats that - can be read and edited only by proprietary word processors, SGML or - XML for which the DTD and/or processing tools are not generally - available, and the machine-generated HTML, PostScript or PDF - produced by some word processors for output purposes only. + SGML or XML using a publicly available DTD, and standard-conforming + simple HTML, PostScript or PDF designed for human modification. + Examples of transparent image formats include PNG, XCF and JPG. + Opaque formats include proprietary formats that can be read and + edited only by proprietary word processors, SGML or XML for which + the DTD and/or processing tools are not generally available, and + the machine-generated HTML, PostScript or PDF produced by some word + processors for output purposes only. The "Title Page" means, for a printed book, the title page itself, plus such following pages as are needed to hold, legibly, the @@ -18858,8 +20106,8 @@ GNU Free Documentation License may not use technical measures to obstruct or control the reading or further copying of the copies you make or distribute. However, you may accept compensation in exchange for copies. If you - distribute a large enough number of copies you must also follow - the conditions in section 3. + distribute a large enough number of copies you must also follow the + conditions in section 3. You may also lend copies, under the same conditions stated above, and you may publicly display copies. @@ -18873,12 +20121,11 @@ GNU Free Documentation License these Cover Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on the back cover. Both covers must also clearly and legibly identify you as the publisher of these copies. The - front cover must present the full title with all words of the - title equally prominent and visible. You may add other material - on the covers in addition. Copying with changes limited to the - covers, as long as they preserve the title of the Document and - satisfy these conditions, can be treated as verbatim copying in - other respects. + front cover must present the full title with all words of the title + equally prominent and visible. You may add other material on the + covers in addition. Copying with changes limited to the covers, as + long as they preserve the title of the Document and satisfy these + conditions, can be treated as verbatim copying in other respects. If the required texts for either cover are too voluminous to fit legibly, you should put the first ones listed (as many as fit @@ -18886,40 +20133,39 @@ GNU Free Documentation License adjacent pages. If you publish or distribute Opaque copies of the Document - numbering more than 100, you must either include a - machine-readable Transparent copy along with each Opaque copy, or - state in or with each Opaque copy a computer-network location from - which the general network-using public has access to download - using public-standard network protocols a complete Transparent - copy of the Document, free of added material. If you use the - latter option, you must take reasonably prudent steps, when you - begin distribution of Opaque copies in quantity, to ensure that - this Transparent copy will remain thus accessible at the stated - location until at least one year after the last time you - distribute an Opaque copy (directly or through your agents or - retailers) of that edition to the public. + numbering more than 100, you must either include a machine-readable + Transparent copy along with each Opaque copy, or state in or with + each Opaque copy a computer-network location from which the general + network-using public has access to download using public-standard + network protocols a complete Transparent copy of the Document, free + of added material. If you use the latter option, you must take + reasonably prudent steps, when you begin distribution of Opaque + copies in quantity, to ensure that this Transparent copy will + remain thus accessible at the stated location until at least one + year after the last time you distribute an Opaque copy (directly or + through your agents or retailers) of that edition to the public. It is requested, but not required, that you contact the authors of - the Document well before redistributing any large number of - copies, to give them a chance to provide you with an updated - version of the Document. + the Document well before redistributing any large number of copies, + to give them a chance to provide you with an updated version of the + Document. 4. MODIFICATIONS You may copy and distribute a Modified Version of the Document under the conditions of sections 2 and 3 above, provided that you - release the Modified Version under precisely this License, with - the Modified Version filling the role of the Document, thus - licensing distribution and modification of the Modified Version to - whoever possesses a copy of it. In addition, you must do these - things in the Modified Version: + release the Modified Version under precisely this License, with the + Modified Version filling the role of the Document, thus licensing + distribution and modification of the Modified Version to whoever + possesses a copy of it. In addition, you must do these things in + the Modified Version: A. Use in the Title Page (and on the covers, if any) a title - distinct from that of the Document, and from those of - previous versions (which should, if there were any, be listed - in the History section of the Document). You may use the - same title as a previous version if the original publisher of - that version gives permission. + distinct from that of the Document, and from those of previous + versions (which should, if there were any, be listed in the + History section of the Document). You may use the same title + as a previous version if the original publisher of that + version gives permission. B. List on the Title Page, as authors, one or more persons or entities responsible for authorship of the modifications in @@ -18949,31 +20195,30 @@ GNU Free Documentation License I. Preserve the section Entitled "History", Preserve its Title, and add to it an item stating at least the title, year, new - authors, and publisher of the Modified Version as given on - the Title Page. If there is no section Entitled "History" in - the Document, create one stating the title, year, authors, - and publisher of the Document as given on its Title Page, - then add an item describing the Modified Version as stated in - the previous sentence. + authors, and publisher of the Modified Version as given on the + Title Page. If there is no section Entitled "History" in the + Document, create one stating the title, year, authors, and + publisher of the Document as given on its Title Page, then add + an item describing the Modified Version as stated in the + previous sentence. J. Preserve the network location, if any, given in the Document for public access to a Transparent copy of the Document, and likewise the network locations given in the Document for - previous versions it was based on. These may be placed in - the "History" section. You may omit a network location for a - work that was published at least four years before the - Document itself, or if the original publisher of the version - it refers to gives permission. + previous versions it was based on. These may be placed in the + "History" section. You may omit a network location for a work + that was published at least four years before the Document + itself, or if the original publisher of the version it refers + to gives permission. K. For any section Entitled "Acknowledgements" or "Dedications", - Preserve the Title of the section, and preserve in the - section all the substance and tone of each of the contributor + Preserve the Title of the section, and preserve in the section + all the substance and tone of each of the contributor acknowledgements and/or dedications given therein. - L. Preserve all the Invariant Sections of the Document, - unaltered in their text and in their titles. Section numbers - or the equivalent are not considered part of the section - titles. + L. Preserve all the Invariant Sections of the Document, unaltered + in their text and in their titles. Section numbers or the + equivalent are not considered part of the section titles. M. Delete any section Entitled "Endorsements". Such a section may not be included in the Modified Version. @@ -18986,11 +20231,11 @@ GNU Free Documentation License If the Modified Version includes new front-matter sections or appendices that qualify as Secondary Sections and contain no - material copied from the Document, you may at your option - designate some or all of these sections as invariant. To do this, - add their titles to the list of Invariant Sections in the Modified - Version's license notice. These titles must be distinct from any - other section titles. + material copied from the Document, you may at your option designate + some or all of these sections as invariant. To do this, add their + titles to the list of Invariant Sections in the Modified Version's + license notice. These titles must be distinct from any other + section titles. You may add a section Entitled "Endorsements", provided it contains nothing but endorsements of your Modified Version by various @@ -18999,15 +20244,15 @@ GNU Free Documentation License definition of a standard. You may add a passage of up to five words as a Front-Cover Text, - and a passage of up to 25 words as a Back-Cover Text, to the end - of the list of Cover Texts in the Modified Version. Only one - passage of Front-Cover Text and one of Back-Cover Text may be - added by (or through arrangements made by) any one entity. If the - Document already includes a cover text for the same cover, - previously added by you or by arrangement made by the same entity - you are acting on behalf of, you may not add another; but you may - replace the old one, on explicit permission from the previous - publisher that added the old one. + and a passage of up to 25 words as a Back-Cover Text, to the end of + the list of Cover Texts in the Modified Version. Only one passage + of Front-Cover Text and one of Back-Cover Text may be added by (or + through arrangements made by) any one entity. If the Document + already includes a cover text for the same cover, previously added + by you or by arrangement made by the same entity you are acting on + behalf of, you may not add another; but you may replace the old + one, on explicit permission from the previous publisher that added + the old one. The author(s) and publisher(s) of the Document do not by this License give permission to use their names for publicity for or to @@ -19017,8 +20262,8 @@ GNU Free Documentation License You may combine the Document with other documents released under this License, under the terms defined in section 4 above for - modified versions, provided that you include in the combination - all of the Invariant Sections of all of the original documents, + modified versions, provided that you include in the combination all + of the Invariant Sections of all of the original documents, unmodified, and list them all as Invariant Sections of your combined work in its license notice, and that you preserve all their Warranty Disclaimers. @@ -19045,20 +20290,20 @@ GNU Free Documentation License documents released under this License, and replace the individual copies of this License in the various documents with a single copy that is included in the collection, provided that you follow the - rules of this License for verbatim copying of each of the - documents in all other respects. + rules of this License for verbatim copying of each of the documents + in all other respects. You may extract a single document from such a collection, and distribute it individually under this License, provided you insert - a copy of this License into the extracted document, and follow - this License in all other respects regarding verbatim copying of - that document. + a copy of this License into the extracted document, and follow this + License in all other respects regarding verbatim copying of that + document. 7. AGGREGATION WITH INDEPENDENT WORKS A compilation of the Document or its derivatives with other - separate and independent documents or works, in or on a volume of - a storage or distribution medium, is called an "aggregate" if the + separate and independent documents or works, in or on a volume of a + storage or distribution medium, is called an "aggregate" if the copyright resulting from the compilation is not used to limit the legal rights of the compilation's users beyond what the individual works permit. When the Document is included in an aggregate, this @@ -19103,8 +20348,8 @@ GNU Free Documentation License However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly - and finally terminates your license, and (b) permanently, if the + provisionally, unless and until the copyright holder explicitly and + finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. @@ -19116,33 +20361,33 @@ GNU Free Documentation License after your receipt of the notice. Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from - you under this License. If your rights have been terminated and - not permanently reinstated, receipt of a copy of some or all of - the same material does not give you any rights to use it. + the licenses of parties who have received copies or rights from you + under this License. If your rights have been terminated and not + permanently reinstated, receipt of a copy of some or all of the + same material does not give you any rights to use it. - 10. FUTURE REVISIONS OF THIS LICENSE + 10. FUTURE REVISIONS OF THIS LICENSE The Free Software Foundation may publish new, revised versions of the GNU Free Documentation License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. See - `http://www.gnu.org/copyleft/'. + <http://www.gnu.org/copyleft/>. Each version of the License is given a distinguishing version number. If the Document specifies that a particular numbered version of this License "or any later version" applies to it, you have the option of following the terms and conditions either of that specified version or of any later version that has been - published (not as a draft) by the Free Software Foundation. If - the Document does not specify a version number of this License, - you may choose any version ever published (not as a draft) by the - Free Software Foundation. If the Document specifies that a proxy - can decide which future versions of this License can be used, that + published (not as a draft) by the Free Software Foundation. If the + Document does not specify a version number of this License, you may + choose any version ever published (not as a draft) by the Free + Software Foundation. If the Document specifies that a proxy can + decide which future versions of this License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Document. - 11. RELICENSING + 11. RELICENSING "Massive Multiauthor Collaboration Site" (or "MMC Site") means any World Wide Web server that publishes copyrightable works and also @@ -19172,7 +20417,6 @@ GNU Free Documentation License site under CC-BY-SA on the same site at any time before August 1, 2009, provided the MMC is eligible for relicensing. - ADDENDUM: How to use this License for your documents ==================================================== @@ -19189,7 +20433,7 @@ notices just after the title page: Free Documentation License''. If you have Invariant Sections, Front-Cover Texts and Back-Cover -Texts, replace the "with...Texts." line with this: +Texts, replace the "with...Texts." line with this: with the Invariant Sections being LIST THEIR TITLES, with the Front-Cover Texts being LIST, and with the Back-Cover Texts @@ -19200,9 +20444,9 @@ combination of the three, merge those two alternatives to suit the situation. If your document contains nontrivial examples of program code, we -recommend releasing these examples in parallel under your choice of -free software license, such as the GNU General Public License, to -permit their use in free software. +recommend releasing these examples in parallel under your choice of free +software license, such as the GNU General Public License, to permit +their use in free software. File: gfortran.info, Node: Funding, Next: Option Index, Prev: GNU Free Documentation License, Up: Top @@ -19232,8 +20476,8 @@ for comparison. Even a precise fraction "of the profits from this disk" is not very meaningful, since creative accounting and unrelated business decisions -can greatly alter what fraction of the sales price counts as profit. -If the price you pay is $50, ten percent of the profit is probably less +can greatly alter what fraction of the sales price counts as profit. If +the price you pay is $50, ten percent of the profit is probably less than a dollar; it might be a few cents, or nothing at all. Some redistributors do development work themselves. This is useful @@ -19243,8 +20487,8 @@ difference than others. For example, maintaining a separate version of a program contributes very little; maintaining the standard version of a program for the whole community contributes much. Easy new ports contribute little, since someone else would surely do them; difficult -ports such as adding a new CPU to the GNU Compiler Collection -contribute more; major new features or packages contribute the most. +ports such as adding a new CPU to the GNU Compiler Collection contribute +more; major new features or packages contribute the most. By establishing the idea that supporting further development is "the proper thing to do" when distributing free software for a fee, we can @@ -19260,25 +20504,25 @@ File: gfortran.info, Node: Option Index, Next: Keyword Index, Prev: Funding, Option Index ************ -`gfortran''s command line options are indexed here without any initial -`-' or `--'. Where an option has both positive and negative forms -(such as -foption and -fno-option), relevant entries in the manual are -indexed under the most appropriate form; it may sometimes be useful to -look up both forms. +'gfortran''s command line options are indexed here without any initial +'-' or '--'. Where an option has both positive and negative forms (such +as -foption and -fno-option), relevant entries in the manual are indexed +under the most appropriate form; it may sometimes be useful to look up +both forms. * Menu: * A-PREDICATE=ANSWER: Preprocessing Options. - (line 120) + (line 119) * APREDICATE=ANSWER: Preprocessing Options. - (line 114) + (line 113) * backslash: Fortran Dialect Options. - (line 56) + (line 74) * C: Preprocessing Options. - (line 123) + (line 122) * CC: Preprocessing Options. - (line 138) + (line 137) * cpp: Preprocessing Options. (line 12) * dD: Preprocessing Options. @@ -19290,205 +20534,220 @@ look up both forms. * dN: Preprocessing Options. (line 41) * DNAME: Preprocessing Options. - (line 153) + (line 151) * DNAME=DEFINITION: Preprocessing Options. - (line 156) + (line 154) * dU: Preprocessing Options. (line 44) -* faggressive-function-elimination: Code Gen Options. (line 365) -* falign-commons: Code Gen Options. (line 338) +* faggressive-function-elimination: Code Gen Options. (line 361) +* falign-commons: Code Gen Options. (line 334) * fall-intrinsics: Fortran Dialect Options. (line 17) -* fblas-matmul-limit: Code Gen Options. (line 275) -* fbounds-check: Code Gen Options. (line 199) -* fcheck: Code Gen Options. (line 143) -* fcheck-array-temporaries: Code Gen Options. (line 202) -* fcoarray: Code Gen Options. (line 129) +* fblas-matmul-limit: Code Gen Options. (line 274) +* fbounds-check: Code Gen Options. (line 198) +* fcheck: Code Gen Options. (line 141) +* fcheck-array-temporaries: Code Gen Options. (line 201) +* fcoarray: Code Gen Options. (line 127) * fconvert=CONVERSION: Runtime Options. (line 10) * fcray-pointer: Fortran Dialect Options. - (line 102) + (line 120) * fd-lines-as-code: Fortran Dialect Options. (line 27) * fd-lines-as-comments: Fortran Dialect Options. (line 27) * fdec: Fortran Dialect Options. (line 34) +* fdec-intrinsic-ints: Fortran Dialect Options. + (line 54) +* fdec-math: Fortran Dialect Options. + (line 59) +* fdec-static: Fortran Dialect Options. + (line 64) * fdec-structure: Fortran Dialect Options. - (line 44) + (line 48) * fdefault-double-8: Fortran Dialect Options. - (line 152) + (line 169) * fdefault-integer-8: Fortran Dialect Options. - (line 138) + (line 155) * fdefault-real-8: Fortran Dialect Options. - (line 144) + (line 161) * fdollar-ok: Fortran Dialect Options. - (line 50) + (line 68) * fdump-fortran-optimized: Debugging Options. (line 15) * fdump-fortran-original: Debugging Options. (line 10) * fdump-parse-tree: Debugging Options. (line 19) -* fexternal-blas: Code Gen Options. (line 267) +* fexternal-blas: Code Gen Options. (line 266) * ff2c: Code Gen Options. (line 25) * ffixed-form: Fortran Dialect Options. (line 11) * ffixed-line-length-N: Fortran Dialect Options. - (line 73) -* ffpe-summary=LIST: Debugging Options. (line 52) + (line 91) +* ffpe-summary=LIST: Debugging Options. (line 51) * ffpe-trap=LIST: Debugging Options. (line 25) * ffree-form: Fortran Dialect Options. (line 11) * ffree-line-length-N: Fortran Dialect Options. - (line 86) + (line 104) * fimplicit-none: Fortran Dialect Options. - (line 97) -* finit-character: Code Gen Options. (line 310) -* finit-integer: Code Gen Options. (line 310) -* finit-local-zero: Code Gen Options. (line 310) -* finit-logical: Code Gen Options. (line 310) -* finit-real: Code Gen Options. (line 310) -* finline-matmul-limit: Code Gen Options. (line 286) + (line 115) +* finit-character: Code Gen Options. (line 309) +* finit-derived: Code Gen Options. (line 309) +* finit-integer: Code Gen Options. (line 309) +* finit-local-zero: Code Gen Options. (line 309) +* finit-logical: Code Gen Options. (line 309) +* finit-real: Code Gen Options. (line 309) +* finline-matmul-limit: Code Gen Options. (line 285) * finteger-4-integer-8: Fortran Dialect Options. - (line 161) + (line 178) * fintrinsic-modules-path DIR: Directory Options. (line 36) -* fmax-array-constructor: Code Gen Options. (line 205) +* fmax-array-constructor: Code Gen Options. (line 204) * fmax-errors=N: Error and Warning Options. (line 27) * fmax-identifier-length=N: Fortran Dialect Options. - (line 93) -* fmax-stack-var-size: Code Gen Options. (line 223) + (line 111) +* fmax-stack-var-size: Code Gen Options. (line 222) * fmax-subrecord-length=LENGTH: Runtime Options. (line 29) * fmodule-private: Fortran Dialect Options. - (line 68) + (line 86) * fno-automatic: Code Gen Options. (line 15) -* fno-backtrace: Debugging Options. (line 62) -* fno-protect-parens: Code Gen Options. (line 350) +* fno-backtrace: Debugging Options. (line 61) +* fno-protect-parens: Code Gen Options. (line 346) * fno-underscoring: Code Gen Options. (line 54) * fopenacc: Fortran Dialect Options. - (line 106) + (line 124) * fopenmp: Fortran Dialect Options. - (line 118) -* fpack-derived: Code Gen Options. (line 245) + (line 135) +* fpack-derived: Code Gen Options. (line 244) * fpp: Preprocessing Options. (line 12) * frange-check: Fortran Dialect Options. - (line 126) + (line 143) * freal-4-real-10: Fortran Dialect Options. - (line 177) + (line 193) * freal-4-real-16: Fortran Dialect Options. - (line 177) + (line 193) * freal-4-real-8: Fortran Dialect Options. - (line 177) + (line 193) * freal-8-real-10: Fortran Dialect Options. - (line 177) + (line 193) * freal-8-real-16: Fortran Dialect Options. - (line 177) + (line 193) * freal-8-real-4: Fortran Dialect Options. - (line 177) -* frealloc-lhs: Code Gen Options. (line 359) + (line 193) +* frealloc-lhs: Code Gen Options. (line 355) * frecord-marker=LENGTH: Runtime Options. (line 21) -* frecursive: Code Gen Options. (line 301) -* frepack-arrays: Code Gen Options. (line 251) -* frontend-optimize: Code Gen Options. (line 373) -* fsecond-underscore: Code Gen Options. (line 112) +* frecursive: Code Gen Options. (line 299) +* frepack-arrays: Code Gen Options. (line 250) +* frontend-optimize: Code Gen Options. (line 369) +* fsecond-underscore: Code Gen Options. (line 110) +* fshort-enums: Code Gen Options. (line 260) * fshort-enums <1>: Fortran 2003 status. (line 93) -* fshort-enums: Code Gen Options. (line 261) * fsign-zero: Runtime Options. (line 34) -* fstack-arrays: Code Gen Options. (line 237) +* fstack-arrays: Code Gen Options. (line 236) * fsyntax-only: Error and Warning Options. (line 33) +* ftest-forall-temp: Fortran Dialect Options. + (line 223) * fworking-directory: Preprocessing Options. (line 55) * H: Preprocessing Options. - (line 176) + (line 174) * IDIR: Directory Options. (line 14) * idirafter DIR: Preprocessing Options. - (line 70) + (line 69) * imultilib DIR: Preprocessing Options. - (line 77) + (line 76) * iprefix PREFIX: Preprocessing Options. - (line 81) + (line 80) * iquote DIR: Preprocessing Options. - (line 90) + (line 89) * isysroot DIR: Preprocessing Options. - (line 86) + (line 85) * isystem DIR: Preprocessing Options. - (line 97) + (line 96) * JDIR: Directory Options. (line 29) * MDIR: Directory Options. (line 29) * nostdinc: Preprocessing Options. - (line 105) + (line 104) * P: Preprocessing Options. - (line 181) + (line 179) * pedantic: Error and Warning Options. - (line 38) + (line 39) * pedantic-errors: Error and Warning Options. - (line 57) + (line 58) * static-libgfortran: Link Options. (line 11) * std=STD option: Fortran Dialect Options. - (line 188) + (line 204) * UNAME: Preprocessing Options. - (line 187) + (line 185) * undef: Preprocessing Options. - (line 110) + (line 109) * Waliasing: Error and Warning Options. - (line 69) + (line 71) * Walign-commons: Error and Warning Options. - (line 210) + (line 222) * Wall: Error and Warning Options. - (line 61) + (line 62) * Wampersand: Error and Warning Options. - (line 86) + (line 88) +* Wargument-mismatch: Error and Warning Options. + (line 96) * Warray-temporaries: Error and Warning Options. - (line 94) + (line 101) * Wc-binding-type: Error and Warning Options. - (line 99) -* Wcharacter-truncation: Error and Warning Options. (line 106) +* Wcharacter-truncation: Error and Warning Options. + (line 113) * Wcompare-reals: Error and Warning Options. - (line 238) + (line 249) * Wconversion: Error and Warning Options. - (line 115) + (line 122) * Wconversion-extra: Error and Warning Options. - (line 119) + (line 126) * Werror: Error and Warning Options. - (line 250) + (line 261) * Wextra: Error and Warning Options. - (line 123) + (line 130) * Wfunction-elimination: Error and Warning Options. - (line 216) + (line 228) * Wimplicit-interface: Error and Warning Options. - (line 128) + (line 135) * Wimplicit-procedure: Error and Warning Options. - (line 134) + (line 141) * Winteger-division: Error and Warning Options. - (line 138) + (line 145) * Wintrinsic-shadow: Error and Warning Options. - (line 188) + (line 200) * Wintrinsics-std: Error and Warning Options. - (line 142) + (line 149) * Wline-truncation: Error and Warning Options. - (line 109) + (line 116) +* Wpedantic: Error and Warning Options. + (line 39) * Wreal-q-constant: Error and Warning Options. - (line 149) + (line 156) * Wrealloc-lhs: Error and Warning Options. - (line 220) + (line 232) * Wrealloc-lhs-all: Error and Warning Options. - (line 233) + (line 244) * Wsurprising: Error and Warning Options. - (line 153) + (line 160) * Wtabs: Error and Warning Options. - (line 175) + (line 182) * Wtargt-lifetime: Error and Warning Options. - (line 242) + (line 253) +* Wundefined-do-loop: Error and Warning Options. + (line 190) * Wunderflow: Error and Warning Options. - (line 183) + (line 195) * Wunused-dummy-argument: Error and Warning Options. - (line 199) + (line 211) * Wunused-parameter: Error and Warning Options. - (line 203) + (line 215) * Wuse-without-only: Error and Warning Options. - (line 195) + (line 207) * Wzerotrip: Error and Warning Options. - (line 246) + (line 257) File: gfortran.info, Node: Keyword Index, Prev: Option Index, Up: Top @@ -19500,7 +20759,7 @@ Keyword Index * Menu: * $: Fortran Dialect Options. - (line 50) + (line 68) * %LOC: Argument list functions. (line 6) * %REF: Argument list functions. @@ -19508,7 +20767,7 @@ Keyword Index * %VAL: Argument list functions. (line 6) * &: Error and Warning Options. - (line 86) + (line 88) * [...]: Fortran 2003 status. (line 78) * _gfortran_set_args: _gfortran_set_args. (line 6) * _gfortran_set_convert: _gfortran_set_convert. @@ -19524,12 +20783,13 @@ Keyword Index * ABS: ABS. (line 6) * absolute value: ABS. (line 6) * ACCESS: ACCESS. (line 6) -* ACCESS='STREAM' I/O: Fortran 2003 status. (line 105) +* ACCESS='STREAM' I/O: Fortran 2003 status. (line 103) * ACHAR: ACHAR. (line 6) * ACOS: ACOS. (line 6) +* ACOSD: ACOSD. (line 6) * ACOSH: ACOSH. (line 6) -* adjust string <1>: ADJUSTR. (line 6) * adjust string: ADJUSTL. (line 6) +* adjust string <1>: ADJUSTR. (line 6) * ADJUSTL: ADJUSTL. (line 6) * ADJUSTR: ADJUSTR. (line 6) * AIMAG: AIMAG. (line 6) @@ -19537,17 +20797,17 @@ Keyword Index * ALARM: ALARM. (line 6) * ALGAMA: LOG_GAMMA. (line 6) * aliasing: Error and Warning Options. - (line 69) -* alignment of COMMON blocks <1>: Code Gen Options. (line 338) + (line 71) * alignment of COMMON blocks: Error and Warning Options. - (line 210) + (line 222) +* alignment of COMMON blocks <1>: Code Gen Options. (line 334) * ALL: ALL. (line 6) * all warnings: Error and Warning Options. - (line 61) + (line 62) * ALLOCATABLE components of derived types: Fortran 2003 status. - (line 103) + (line 101) * ALLOCATABLE dummy arguments: Fortran 2003 status. (line 99) -* ALLOCATABLE function results: Fortran 2003 status. (line 101) +* ALLOCATABLE function results: Fortran 2003 status. (line 100) * ALLOCATED: ALLOCATED. (line 6) * allocation, moving: MOVE_ALLOC. (line 6) * allocation, status: ALLOCATED. (line 6) @@ -19566,22 +20826,22 @@ Keyword Index * area hyperbolic tangent: ATANH. (line 6) * argument list functions: Argument list functions. (line 6) -* arguments, to program <1>: IARGC. (line 6) -* arguments, to program <2>: GET_COMMAND_ARGUMENT. - (line 6) -* arguments, to program <3>: GET_COMMAND. (line 6) -* arguments, to program <4>: GETARG. (line 6) * arguments, to program: COMMAND_ARGUMENT_COUNT. (line 6) +* arguments, to program <1>: GETARG. (line 6) +* arguments, to program <2>: GET_COMMAND. (line 6) +* arguments, to program <3>: GET_COMMAND_ARGUMENT. + (line 6) +* arguments, to program <4>: IARGC. (line 6) * array, add elements: SUM. (line 6) * array, AND: IALL. (line 6) -* array, apply condition <1>: ANY. (line 6) * array, apply condition: ALL. (line 6) -* array, bounds checking: Code Gen Options. (line 143) +* array, apply condition <1>: ANY. (line 6) +* array, bounds checking: Code Gen Options. (line 141) * array, change dimensions: RESHAPE. (line 6) * array, combine arrays: MERGE. (line 6) -* array, condition testing <1>: ANY. (line 6) * array, condition testing: ALL. (line 6) +* array, condition testing <1>: ANY. (line 6) * array, conditionally add elements: SUM. (line 6) * array, conditionally count elements: COUNT. (line 6) * array, conditionally multiply elements: PRODUCT. (line 6) @@ -19591,8 +20851,8 @@ Keyword Index * array, duplicate elements: SPREAD. (line 6) * array, element counting: COUNT. (line 6) * array, gather elements: PACK. (line 6) -* array, increase dimension <1>: UNPACK. (line 6) * array, increase dimension: SPREAD. (line 6) +* array, increase dimension <1>: UNPACK. (line 6) * array, indices of type real: Real array indices. (line 6) * array, location of maximum element: MAXLOC. (line 6) * array, location of minimum element: MINLOC. (line 6) @@ -19601,8 +20861,8 @@ Keyword Index * array, merge arrays: MERGE. (line 6) * array, minimum value: MINVAL. (line 6) * array, multiply elements: PRODUCT. (line 6) -* array, number of elements <1>: SIZE. (line 6) * array, number of elements: COUNT. (line 6) +* array, number of elements <1>: SIZE. (line 6) * array, OR: IANY. (line 6) * array, packing: PACK. (line 6) * array, parity: IPARITY. (line 6) @@ -19621,15 +20881,18 @@ Keyword Index * array, unpacking: UNPACK. (line 6) * array, upper bound: UBOUND. (line 6) * array, XOR: IPARITY. (line 6) -* ASCII collating sequence <1>: IACHAR. (line 6) * ASCII collating sequence: ACHAR. (line 6) +* ASCII collating sequence <1>: IACHAR. (line 6) * ASIN: ASIN. (line 6) +* ASIND: ASIND. (line 6) * ASINH: ASINH. (line 6) * ASSOCIATED: ASSOCIATED. (line 6) * association status: ASSOCIATED. (line 6) * association status, C pointer: C_ASSOCIATED. (line 6) * ATAN: ATAN. (line 6) * ATAN2: ATAN2. (line 6) +* ATAN2D: ATAN2D. (line 6) +* ATAND: ATAND. (line 6) * ATANH: ATANH. (line 6) * Atomic subroutine, add: ATOMIC_ADD. (line 6) * Atomic subroutine, ADD with fetch: ATOMIC_FETCH_ADD. (line 6) @@ -19644,8 +20907,8 @@ Keyword Index * Atomic subroutine, XOR with fetch: ATOMIC_FETCH_XOR. (line 6) * ATOMIC_ADD: ATOMIC_ADD. (line 6) * ATOMIC_AND: ATOMIC_AND. (line 6) -* ATOMIC_DEFINE <1>: ATOMIC_DEFINE. (line 6) * ATOMIC_DEFINE: ATOMIC_CAS. (line 6) +* ATOMIC_DEFINE <1>: ATOMIC_DEFINE. (line 6) * ATOMIC_FETCH_ADD: ATOMIC_FETCH_ADD. (line 6) * ATOMIC_FETCH_AND: ATOMIC_FETCH_AND. (line 6) * ATOMIC_FETCH_OR: ATOMIC_FETCH_OR. (line 6) @@ -19654,23 +20917,30 @@ Keyword Index * ATOMIC_REF: ATOMIC_REF. (line 6) * ATOMIC_XOR: ATOMIC_XOR. (line 6) * Authors: Contributors. (line 6) +* AUTOMATIC: AUTOMATIC and STATIC attributes. + (line 6) +* BABS: ABS. (line 6) * backslash: Fortran Dialect Options. - (line 56) + (line 74) * BACKSPACE: Read/Write after EOF marker. (line 6) -* backtrace: BACKTRACE. (line 6) * BACKTRACE: BACKTRACE. (line 6) -* backtrace: Debugging Options. (line 62) +* backtrace: Debugging Options. (line 61) +* backtrace <1>: BACKTRACE. (line 6) * base 10 logarithm function: LOG10. (line 6) +* BBCLR: IBCLR. (line 6) +* BBITS: IBITS. (line 6) +* BBSET: IBSET. (line 6) +* BBTEST: BTEST. (line 6) * BESJ0: BESSEL_J0. (line 6) * BESJ1: BESSEL_J1. (line 6) * BESJN: BESSEL_JN. (line 6) -* Bessel function, first kind <1>: BESSEL_JN. (line 6) -* Bessel function, first kind <2>: BESSEL_J1. (line 6) * Bessel function, first kind: BESSEL_J0. (line 6) -* Bessel function, second kind <1>: BESSEL_YN. (line 6) -* Bessel function, second kind <2>: BESSEL_Y1. (line 6) +* Bessel function, first kind <1>: BESSEL_J1. (line 6) +* Bessel function, first kind <2>: BESSEL_JN. (line 6) * Bessel function, second kind: BESSEL_Y0. (line 6) +* Bessel function, second kind <1>: BESSEL_Y1. (line 6) +* Bessel function, second kind <2>: BESSEL_YN. (line 6) * BESSEL_J0: BESSEL_J0. (line 6) * BESSEL_J1: BESSEL_J1. (line 6) * BESSEL_JN: BESSEL_JN. (line 6) @@ -19682,85 +20952,95 @@ Keyword Index * BESYN: BESSEL_YN. (line 6) * BGE: BGE. (line 6) * BGT: BGT. (line 6) -* binary representation <1>: POPPAR. (line 6) +* BIAND: IAND. (line 6) +* BIEOR: IEOR. (line 6) * binary representation: POPCNT. (line 6) -* BIT_SIZE: BIT_SIZE. (line 6) +* binary representation <1>: POPPAR. (line 6) +* BIOR: IOR. (line 6) +* BITEST: BTEST. (line 6) * bits set: POPCNT. (line 6) * bits, AND of array elements: IALL. (line 6) * bits, clear: IBCLR. (line 6) * bits, extract: IBITS. (line 6) * bits, get: IBITS. (line 6) * bits, merge: MERGE_BITS. (line 6) -* bits, move <1>: TRANSFER. (line 6) * bits, move: MVBITS. (line 6) +* bits, move <1>: TRANSFER. (line 6) * bits, negate: NOT. (line 6) * bits, number of: BIT_SIZE. (line 6) * bits, OR of array elements: IANY. (line 6) * bits, set: IBSET. (line 6) * bits, shift: ISHFT. (line 6) * bits, shift circular: ISHFTC. (line 6) -* bits, shift left <1>: SHIFTL. (line 6) * bits, shift left: LSHIFT. (line 6) -* bits, shift right <1>: SHIFTR. (line 6) -* bits, shift right <2>: SHIFTA. (line 6) +* bits, shift left <1>: SHIFTL. (line 6) * bits, shift right: RSHIFT. (line 6) +* bits, shift right <1>: SHIFTA. (line 6) +* bits, shift right <2>: SHIFTR. (line 6) * bits, testing: BTEST. (line 6) * bits, unset: IBCLR. (line 6) * bits, XOR of array elements: IPARITY. (line 6) -* bitwise comparison <1>: BLT. (line 6) -* bitwise comparison <2>: BLE. (line 6) -* bitwise comparison <3>: BGT. (line 6) * bitwise comparison: BGE. (line 6) -* bitwise logical and <1>: IAND. (line 6) +* bitwise comparison <1>: BGT. (line 6) +* bitwise comparison <2>: BLE. (line 6) +* bitwise comparison <3>: BLT. (line 6) * bitwise logical and: AND. (line 6) -* bitwise logical exclusive or <1>: XOR. (line 6) +* bitwise logical and <1>: IAND. (line 6) * bitwise logical exclusive or: IEOR. (line 6) +* bitwise logical exclusive or <1>: XOR. (line 6) * bitwise logical not: NOT. (line 6) -* bitwise logical or <1>: OR. (line 6) * bitwise logical or: IOR. (line 6) +* bitwise logical or <1>: OR. (line 6) +* BIT_SIZE: BIT_SIZE. (line 6) +* BJTEST: BTEST. (line 6) +* BKTEST: BTEST. (line 6) * BLE: BLE. (line 6) * BLT: BLT. (line 6) -* bounds checking: Code Gen Options. (line 143) +* BMOD: MOD. (line 6) +* BMVBITS: MVBITS. (line 6) +* BNOT: NOT. (line 6) +* bounds checking: Code Gen Options. (line 141) * BOZ literal constants: BOZ literal constants. (line 6) +* BSHFT: ISHFT. (line 6) +* BSHFTC: ISHFTC. (line 6) * BTEST: BTEST. (line 6) -* C_ASSOCIATED: C_ASSOCIATED. (line 6) -* C_F_POINTER: C_F_POINTER. (line 6) -* C_F_PROCPOINTER: C_F_PROCPOINTER. (line 6) -* C_FUNLOC: C_FUNLOC. (line 6) -* C_LOC: C_LOC. (line 6) -* C_SIZEOF: C_SIZEOF. (line 6) * CABS: ABS. (line 6) * calling convention: Code Gen Options. (line 25) +* CARRIAGECONTROL: Extended I/O specifiers. + (line 6) * CCOS: COS. (line 6) +* CCOSD: COSD. (line 6) * CDABS: ABS. (line 6) * CDCOS: COS. (line 6) +* CDCOSD: COSD. (line 6) * CDEXP: EXP. (line 6) * CDLOG: LOG. (line 6) * CDSIN: SIN. (line 6) +* CDSIND: SIND. (line 6) * CDSQRT: SQRT. (line 6) -* ceiling: CEILING. (line 6) * CEILING: CEILING. (line 6) * ceiling: ANINT. (line 6) +* ceiling <1>: CEILING. (line 6) * CEXP: EXP. (line 6) * CHAR: CHAR. (line 6) * character kind: SELECTED_CHAR_KIND. (line 6) * character set: Fortran Dialect Options. - (line 50) + (line 68) * CHDIR: CHDIR. (line 6) -* checking array temporaries: Code Gen Options. (line 143) -* checking subscripts: Code Gen Options. (line 143) +* checking array temporaries: Code Gen Options. (line 141) +* checking subscripts: Code Gen Options. (line 141) * CHMOD: CHMOD. (line 6) -* clock ticks <1>: SYSTEM_CLOCK. (line 6) -* clock ticks <2>: MCLOCK8. (line 6) * clock ticks: MCLOCK. (line 6) +* clock ticks <1>: MCLOCK8. (line 6) +* clock ticks <2>: SYSTEM_CLOCK. (line 6) * CLOG: LOG. (line 6) * CMPLX: CMPLX. (line 6) -* CO_BROADCAST: CO_BROADCAST. (line 6) -* CO_MAX: CO_MAX. (line 6) -* CO_MIN: CO_MIN. (line 6) -* CO_REDUCE: CO_REDUCE. (line 6) -* CO_SUM: CO_SUM. (line 6) +* coarray, IMAGE_INDEX: IMAGE_INDEX. (line 6) +* coarray, lower bound: LCOBOUND. (line 6) +* coarray, NUM_IMAGES: NUM_IMAGES. (line 6) +* coarray, THIS_IMAGE: THIS_IMAGE. (line 6) +* coarray, upper bound: UCOBOUND. (line 6) * Coarray, _gfortran_caf_atomic_cas: _gfortran_caf_atomic_cas. (line 6) * Coarray, _gfortran_caf_atomic_define: _gfortran_caf_atomic_define. @@ -19779,9 +21059,7 @@ Keyword Index (line 6) * Coarray, _gfortran_caf_co_sum: _gfortran_caf_co_sum. (line 6) -* Coarray, _gfortran_caf_deregister <1>: _gfortran_caf_deregister. - (line 6) -* Coarray, _gfortran_caf_deregister: _gfortran_caf_register. +* Coarray, _gfortran_caf_deregister: _gfortran_caf_deregister. (line 6) * Coarray, _gfortran_caf_error_stop: _gfortran_caf_error_stop. (line 6) @@ -19793,16 +21071,34 @@ Keyword Index (line 6) * Coarray, _gfortran_caf_event_wait: _gfortran_caf_event_wait. (line 6) +* Coarray, _gfortran_caf_failed_images: _gfortran_caf_failed_images. + (line 6) +* Coarray, _gfortran_caf_fail_image: _gfortran_caf_fail_image. + (line 6) * Coarray, _gfortran_caf_finish: _gfortran_caf_finish. (line 6) * Coarray, _gfortran_caf_get: _gfortran_caf_get. (line 6) +* Coarray, _gfortran_caf_get_by_ref: _gfortran_caf_get_by_ref. + (line 6) +* Coarray, _gfortran_caf_image_status: _gfortran_caf_image_status. + (line 6) * Coarray, _gfortran_caf_init: _gfortran_caf_init. (line 6) +* Coarray, _gfortran_caf_is_present: _gfortran_caf_is_present. + (line 6) * Coarray, _gfortran_caf_lock: _gfortran_caf_lock. (line 6) * Coarray, _gfortran_caf_num_images: _gfortran_caf_num_images. (line 6) +* Coarray, _gfortran_caf_register: _gfortran_caf_register. + (line 6) * Coarray, _gfortran_caf_send: _gfortran_caf_send. (line 6) * Coarray, _gfortran_caf_sendget: _gfortran_caf_sendget. (line 6) +* Coarray, _gfortran_caf_sendget_by_ref: _gfortran_caf_sendget_by_ref. + (line 6) +* Coarray, _gfortran_caf_send_by_ref: _gfortran_caf_send_by_ref. + (line 6) +* Coarray, _gfortran_caf_stopped_images: _gfortran_caf_stopped_images. + (line 6) * Coarray, _gfortran_caf_sync_all: _gfortran_caf_sync_all. (line 6) * Coarray, _gfortran_caf_sync_images: _gfortran_caf_sync_images. @@ -19813,16 +21109,11 @@ Keyword Index (line 6) * Coarray, _gfortran_caf_unlock: _gfortran_caf_unlock. (line 6) -* coarray, IMAGE_INDEX: IMAGE_INDEX. (line 6) -* coarray, lower bound: LCOBOUND. (line 6) -* coarray, NUM_IMAGES: NUM_IMAGES. (line 6) -* coarray, THIS_IMAGE: THIS_IMAGE. (line 6) -* coarray, upper bound: UCOBOUND. (line 6) +* coarrays: Code Gen Options. (line 127) * Coarrays: Coarray Programming. (line 6) -* coarrays: Code Gen Options. (line 129) * code generation, conventions: Code Gen Options. (line 6) -* collating sequence, ASCII <1>: IACHAR. (line 6) * collating sequence, ASCII: ACHAR. (line 6) +* collating sequence, ASCII <1>: IACHAR. (line 6) * Collectives, generic reduction: CO_REDUCE. (line 6) * Collectives, maximal value: CO_MAX. (line 6) * Collectives, minimal value: CO_MIN. (line 6) @@ -19832,16 +21123,16 @@ Keyword Index (line 6) * command options: Invoking GNU Fortran. (line 6) -* command-line arguments <1>: IARGC. (line 6) -* command-line arguments <2>: GET_COMMAND_ARGUMENT. - (line 6) -* command-line arguments <3>: GET_COMMAND. (line 6) -* command-line arguments <4>: GETARG. (line 6) * command-line arguments: COMMAND_ARGUMENT_COUNT. (line 6) -* command-line arguments, number of <1>: IARGC. (line 6) +* command-line arguments <1>: GETARG. (line 6) +* command-line arguments <2>: GET_COMMAND. (line 6) +* command-line arguments <3>: GET_COMMAND_ARGUMENT. + (line 6) +* command-line arguments <4>: IARGC. (line 6) * command-line arguments, number of: COMMAND_ARGUMENT_COUNT. (line 6) +* command-line arguments, number of <1>: IARGC. (line 6) * COMMAND_ARGUMENT_COUNT: COMMAND_ARGUMENT_COUNT. (line 6) * COMMON: Volatile COMMON blocks. @@ -19854,12 +21145,12 @@ Keyword Index * complex conjugate: CONJG. (line 6) * Complex function: Alternate complex function syntax. (line 6) -* complex numbers, conversion to <1>: DCMPLX. (line 6) -* complex numbers, conversion to <2>: COMPLEX. (line 6) * complex numbers, conversion to: CMPLX. (line 6) +* complex numbers, conversion to <1>: COMPLEX. (line 6) +* complex numbers, conversion to <2>: DCMPLX. (line 6) * complex numbers, imaginary part: AIMAG. (line 6) -* complex numbers, real part <1>: REAL. (line 6) * complex numbers, real part: DREAL. (line 6) +* complex numbers, real part <1>: REAL. (line 6) * Conditional compilation: Preprocessing and conditional compilation. (line 6) * CONJG: CONJG. (line 6) @@ -19868,63 +21159,88 @@ Keyword Index * Contributing: Contributing. (line 6) * Contributors: Contributors. (line 6) * conversion: Error and Warning Options. - (line 115) + (line 122) +* conversion <1>: Error and Warning Options. + (line 126) * conversion, to character: CHAR. (line 6) -* conversion, to complex <1>: DCMPLX. (line 6) -* conversion, to complex <2>: COMPLEX. (line 6) * conversion, to complex: CMPLX. (line 6) -* conversion, to integer <1>: LONG. (line 6) -* conversion, to integer <2>: INT8. (line 6) -* conversion, to integer <3>: INT2. (line 6) -* conversion, to integer <4>: INT. (line 6) -* conversion, to integer <5>: ICHAR. (line 6) -* conversion, to integer <6>: IACHAR. (line 6) +* conversion, to complex <1>: COMPLEX. (line 6) +* conversion, to complex <2>: DCMPLX. (line 6) * conversion, to integer: Implicitly convert LOGICAL and INTEGER values. (line 6) -* conversion, to logical <1>: LOGICAL. (line 6) +* conversion, to integer <1>: IACHAR. (line 6) +* conversion, to integer <2>: ICHAR. (line 6) +* conversion, to integer <3>: INT. (line 6) +* conversion, to integer <4>: INT2. (line 6) +* conversion, to integer <5>: INT8. (line 6) +* conversion, to integer <6>: LONG. (line 6) * conversion, to logical: Implicitly convert LOGICAL and INTEGER values. (line 6) -* conversion, to real <1>: REAL. (line 6) +* conversion, to logical <1>: LOGICAL. (line 6) * conversion, to real: DBLE. (line 6) +* conversion, to real <1>: REAL. (line 6) * conversion, to string: CTIME. (line 6) * CONVERT specifier: CONVERT specifier. (line 6) * core, dump: ABORT. (line 6) * COS: COS. (line 6) +* COSD: COSD. (line 6) * COSH: COSH. (line 6) * cosine: COS. (line 6) +* cosine, degrees: COSD. (line 6) * cosine, hyperbolic: COSH. (line 6) * cosine, hyperbolic, inverse: ACOSH. (line 6) * cosine, inverse: ACOS. (line 6) +* cosine, inverse, degrees: ACOSD. (line 6) +* COTAN: COTAN. (line 6) +* COTAND: COTAND. (line 6) +* cotangent: COTAN. (line 6) +* cotangent, degrees: COTAND. (line 6) * COUNT: COUNT. (line 6) -* CPP <1>: Preprocessing Options. - (line 6) +* CO_BROADCAST: CO_BROADCAST. (line 6) +* CO_MAX: CO_MAX. (line 6) +* CO_MIN: CO_MIN. (line 6) +* CO_REDUCE: CO_REDUCE. (line 6) +* CO_SUM: CO_SUM. (line 6) * CPP: Preprocessing and conditional compilation. (line 6) +* CPP <1>: Preprocessing Options. + (line 6) * CPU_TIME: CPU_TIME. (line 6) * Credits: Contributors. (line 6) * CSHIFT: CSHIFT. (line 6) * CSIN: SIN. (line 6) +* CSIND: SIND. (line 6) * CSQRT: SQRT. (line 6) * CTIME: CTIME. (line 6) -* current date <1>: IDATE. (line 6) -* current date <2>: FDATE. (line 6) * current date: DATE_AND_TIME. (line 6) -* current time <1>: TIME8. (line 6) -* current time <2>: TIME. (line 6) -* current time <3>: ITIME. (line 6) -* current time <4>: FDATE. (line 6) +* current date <1>: FDATE. (line 6) +* current date <2>: IDATE. (line 6) * current time: DATE_AND_TIME. (line 6) +* current time <1>: FDATE. (line 6) +* current time <2>: ITIME. (line 6) +* current time <3>: TIME. (line 6) +* current time <4>: TIME8. (line 6) +* C_ASSOCIATED: C_ASSOCIATED. (line 6) +* C_FUNLOC: C_FUNLOC. (line 6) +* C_F_POINTER: C_F_POINTER. (line 6) +* C_F_PROCPOINTER: C_F_PROCPOINTER. (line 6) +* C_LOC: C_LOC. (line 6) +* C_SIZEOF: C_SIZEOF. (line 6) * DABS: ABS. (line 6) * DACOS: ACOS. (line 6) +* DACOSD: ACOSD. (line 6) * DACOSH: ACOSH. (line 6) * DASIN: ASIN. (line 6) +* DASIND: ASIND. (line 6) * DASINH: ASINH. (line 6) * DATAN: ATAN. (line 6) * DATAN2: ATAN2. (line 6) +* DATAN2D: ATAN2D. (line 6) +* DATAND: ATAND. (line 6) * DATANH: ATANH. (line 6) -* date, current <1>: IDATE. (line 6) -* date, current <2>: FDATE. (line 6) * date, current: DATE_AND_TIME. (line 6) +* date, current <1>: FDATE. (line 6) +* date, current <2>: IDATE. (line 6) * DATE_AND_TIME: DATE_AND_TIME. (line 6) * DBESJ0: BESSEL_J0. (line 6) * DBESJ1: BESSEL_J1. (line 6) @@ -19936,15 +21252,26 @@ Keyword Index * DCMPLX: DCMPLX. (line 6) * DCONJG: CONJG. (line 6) * DCOS: COS. (line 6) +* DCOSD: COSD. (line 6) * DCOSH: COSH. (line 6) +* DCOTAN: COTAN. (line 6) +* DCOTAND: COTAND. (line 6) * DDIM: DIM. (line 6) * debugging information options: Debugging Options. (line 6) * debugging, preprocessor: Preprocessing Options. (line 26) +* debugging, preprocessor <1>: Preprocessing Options. + (line 35) +* debugging, preprocessor <2>: Preprocessing Options. + (line 41) +* debugging, preprocessor <3>: Preprocessing Options. + (line 44) +* debugging, preprocessor <4>: Preprocessing Options. + (line 51) * DECODE: ENCODE and DECODE statements. (line 6) -* delayed execution <1>: SLEEP. (line 6) * delayed execution: ALARM. (line 6) +* delayed execution <1>: SLEEP. (line 6) * DEXP: EXP. (line 6) * DFLOAT: REAL. (line 6) * DGAMMA: GAMMA. (line 6) @@ -19974,27 +21301,29 @@ Keyword Index * DSHIFTR: DSHIFTR. (line 6) * DSIGN: SIGN. (line 6) * DSIN: SIN. (line 6) +* DSIND: SIND. (line 6) * DSINH: SINH. (line 6) * DSQRT: SQRT. (line 6) * DTAN: TAN. (line 6) +* DTAND: TAND. (line 6) * DTANH: TANH. (line 6) * DTIME: DTIME. (line 6) * dummy argument, unused: Error and Warning Options. - (line 199) -* elapsed time <1>: SECOND. (line 6) -* elapsed time <2>: SECNDS. (line 6) + (line 211) * elapsed time: DTIME. (line 6) +* elapsed time <1>: SECNDS. (line 6) +* elapsed time <2>: SECOND. (line 6) * Elimination of functions with identical argument lists: Code Gen Options. - (line 365) + (line 361) * ENCODE: ENCODE and DECODE statements. (line 6) * ENUM statement: Fortran 2003 status. (line 93) * ENUMERATOR statement: Fortran 2003 status. (line 93) -* environment variable <1>: GET_ENVIRONMENT_VARIABLE. +* environment variable: Environment Variables. (line 6) +* environment variable <1>: Runtime. (line 6) * environment variable <2>: GETENV. (line 6) -* environment variable <3>: Runtime. (line 6) -* environment variable: Environment Variables. +* environment variable <3>: GET_ENVIRONMENT_VARIABLE. (line 6) * EOF: Read/Write after EOF marker. (line 6) @@ -20010,22 +21339,23 @@ Keyword Index * errors, limiting: Error and Warning Options. (line 27) * escape characters: Fortran Dialect Options. - (line 56) + (line 74) * ETIME: ETIME. (line 6) * Euclidean distance: HYPOT. (line 6) * Euclidean vector norm: NORM2. (line 6) -* EVENT_QUERY: EVENT_QUERY. (line 6) * Events, EVENT_QUERY: EVENT_QUERY. (line 6) +* EVENT_QUERY: EVENT_QUERY. (line 6) * EXECUTE_COMMAND_LINE: EXECUTE_COMMAND_LINE. (line 6) * EXIT: EXIT. (line 6) * EXP: EXP. (line 6) * EXPONENT: EXPONENT. (line 6) +* exponent: Default exponents. (line 6) * exponential function: EXP. (line 6) -* exponential function, inverse <1>: LOG10. (line 6) * exponential function, inverse: LOG. (line 6) -* expression size <1>: SIZEOF. (line 6) +* exponential function, inverse <1>: LOG10. (line 6) * expression size: C_SIZEOF. (line 6) +* expression size <1>: SIZEOF. (line 6) * EXTENDS_TYPE_OF: EXTENDS_TYPE_OF. (line 6) * extensions: Extensions. (line 6) * extensions, implemented: Extensions implemented in GNU Fortran. @@ -20033,8 +21363,9 @@ Keyword Index * extensions, not implemented: Extensions not implemented in GNU Fortran. (line 6) * extra warnings: Error and Warning Options. - (line 123) + (line 130) * f2c calling convention: Code Gen Options. (line 25) +* f2c calling convention <1>: Code Gen Options. (line 110) * Factorial function: GAMMA. (line 6) * FDATE: FDATE. (line 6) * FDL, GNU Free Documentation License: GNU Free Documentation License. @@ -20043,25 +21374,29 @@ Keyword Index * FGETC: FGETC. (line 6) * file format, fixed: Fortran Dialect Options. (line 11) +* file format, fixed <1>: Fortran Dialect Options. + (line 91) * file format, free: Fortran Dialect Options. (line 11) +* file format, free <1>: Fortran Dialect Options. + (line 104) * file operation, file number: FNUM. (line 6) * file operation, flush: FLUSH. (line 6) -* file operation, position <1>: FTELL. (line 6) * file operation, position: FSEEK. (line 6) -* file operation, read character <1>: FGETC. (line 6) +* file operation, position <1>: FTELL. (line 6) * file operation, read character: FGET. (line 6) +* file operation, read character <1>: FGETC. (line 6) * file operation, seek: FSEEK. (line 6) -* file operation, write character <1>: FPUTC. (line 6) * file operation, write character: FPUT. (line 6) +* file operation, write character <1>: FPUTC. (line 6) * file system, access mode: ACCESS. (line 6) * file system, change access mode: CHMOD. (line 6) -* file system, create link <1>: SYMLNK. (line 6) * file system, create link: LINK. (line 6) +* file system, create link <1>: SYMLNK. (line 6) * file system, file creation mask: UMASK. (line 6) -* file system, file status <1>: STAT. (line 6) -* file system, file status <2>: LSTAT. (line 6) * file system, file status: FSTAT. (line 6) +* file system, file status <1>: LSTAT. (line 6) +* file system, file status <2>: STAT. (line 6) * file system, hard link: LINK. (line 6) * file system, remove file: UNLINK. (line 6) * file system, rename file: RENAME. (line 6) @@ -20070,19 +21405,24 @@ Keyword Index (line 6) * flags inquiry function: COMPILER_OPTIONS. (line 6) * FLOAT: REAL. (line 6) +* FLOATI: REAL. (line 6) * floating point, exponent: EXPONENT. (line 6) * floating point, fraction: FRACTION. (line 6) * floating point, nearest different: NEAREST. (line 6) -* floating point, relative spacing <1>: SPACING. (line 6) * floating point, relative spacing: RRSPACING. (line 6) +* floating point, relative spacing <1>: SPACING. (line 6) * floating point, scale: SCALE. (line 6) * floating point, set exponent: SET_EXPONENT. (line 6) -* floor: FLOOR. (line 6) +* FLOATJ: REAL. (line 6) +* FLOATK: REAL. (line 6) * FLOOR: FLOOR. (line 6) * floor: AINT. (line 6) +* floor <1>: FLOOR. (line 6) * FLUSH: FLUSH. (line 6) * FLUSH statement: Fortran 2003 status. (line 89) * FNUM: FNUM. (line 6) +* form feed whitespace: Form feed as whitespace. + (line 6) * FORMAT: Variable FORMAT expressions. (line 6) * Fortran 77: GNU Fortran and G77. (line 6) @@ -20092,24 +21432,20 @@ Keyword Index * FPUTC: FPUTC. (line 6) * FRACTION: FRACTION. (line 6) * FREE: FREE. (line 6) -* Front-end optimization: Code Gen Options. (line 373) +* Front-end optimization: Code Gen Options. (line 369) * FSEEK: FSEEK. (line 6) * FSTAT: FSTAT. (line 6) * FTELL: FTELL. (line 6) * function elimination: Error and Warning Options. - (line 216) + (line 228) * g77: GNU Fortran and G77. (line 6) * g77 calling convention: Code Gen Options. (line 25) +* g77 calling convention <1>: Code Gen Options. (line 110) * GAMMA: GAMMA. (line 6) * Gamma function: GAMMA. (line 6) * Gamma function, logarithm of: LOG_GAMMA. (line 6) * GCC: GNU Fortran and GCC. (line 6) * GERROR: GERROR. (line 6) -* GET_COMMAND: GET_COMMAND. (line 6) -* GET_COMMAND_ARGUMENT: GET_COMMAND_ARGUMENT. - (line 6) -* GET_ENVIRONMENT_VARIABLE: GET_ENVIRONMENT_VARIABLE. - (line 6) * GETARG: GETARG. (line 6) * GETCWD: GETCWD. (line 6) * GETENV: GETENV. (line 6) @@ -20117,6 +21453,11 @@ Keyword Index * GETLOG: GETLOG. (line 6) * GETPID: GETPID. (line 6) * GETUID: GETUID. (line 6) +* GET_COMMAND: GET_COMMAND. (line 6) +* GET_COMMAND_ARGUMENT: GET_COMMAND_ARGUMENT. + (line 6) +* GET_ENVIRONMENT_VARIABLE: GET_ENVIRONMENT_VARIABLE. + (line 6) * GMTIME: GMTIME. (line 6) * GNU Compiler Collection: GNU Fortran and GCC. (line 6) * GNU Fortran command options: Invoking GNU Fortran. @@ -20136,6 +21477,8 @@ Keyword Index * hyperbolic tangent: TANH. (line 6) * HYPOT: HYPOT. (line 6) * I/O item lists: I/O item lists. (line 6) +* I/O specifiers: Extended I/O specifiers. + (line 6) * IABS: ABS. (line 6) * IACHAR: IACHAR. (line 6) * IALL: IALL. (line 6) @@ -20154,16 +21497,28 @@ Keyword Index * IEOR: IEOR. (line 6) * IERRNO: IERRNO. (line 6) * IFIX: INT. (line 6) +* IIABS: ABS. (line 6) +* IIAND: IAND. (line 6) +* IIBCLR: IBCLR. (line 6) +* IIBITS: IBITS. (line 6) +* IIBSET: IBSET. (line 6) +* IIEOR: IEOR. (line 6) +* IIOR: IOR. (line 6) +* IISHFT: ISHFT. (line 6) +* IISHFTC: ISHFTC. (line 6) * IMAG: AIMAG. (line 6) -* IMAGE_INDEX: IMAGE_INDEX. (line 6) * images, cosubscript to image index conversion: IMAGE_INDEX. (line 6) * images, index of this image: THIS_IMAGE. (line 6) * images, number of: NUM_IMAGES. (line 6) +* IMAGE_INDEX: IMAGE_INDEX. (line 6) * IMAGPART: AIMAG. (line 6) -* IMPORT statement: Fortran 2003 status. (line 122) +* IMOD: MOD. (line 6) +* IMPORT statement: Fortran 2003 status. (line 120) +* IMVBITS: MVBITS. (line 6) * INCLUDE directive: Directory Options. (line 6) * inclusion, directory search paths for: Directory Options. (line 14) * INDEX: INDEX intrinsic. (line 6) +* INOT: NOT. (line 6) * INT: INT. (line 6) * INT2: INT2. (line 6) * INT8: INT8. (line 6) @@ -20171,10 +21526,18 @@ Keyword Index * Interoperability: Mixed-Language Programming. (line 6) * intrinsic: Error and Warning Options. - (line 188) + (line 200) +* intrinsic <1>: Error and Warning Options. + (line 207) * intrinsic Modules: Intrinsic Modules. (line 6) * intrinsic procedures: Intrinsic Procedures. (line 6) +* intrinsics, integer: Type variants for integer intrinsics. + (line 6) +* intrinsics, math: Extended math intrinsics. + (line 6) +* intrinsics, trigonometric functions: Extended math intrinsics. + (line 6) * Introduction: Top. (line 6) * inverse hyperbolic cosine: ACOSH. (line 6) * inverse hyperbolic sine: ASINH. (line 6) @@ -20185,25 +21548,49 @@ Keyword Index * IOSTAT, end of record: IS_IOSTAT_EOR. (line 6) * IPARITY: IPARITY. (line 6) * IRAND: IRAND. (line 6) -* IS_IOSTAT_END: IS_IOSTAT_END. (line 6) -* IS_IOSTAT_EOR: IS_IOSTAT_EOR. (line 6) * ISATTY: ISATTY. (line 6) * ISHFT: ISHFT. (line 6) * ISHFTC: ISHFTC. (line 6) * ISIGN: SIGN. (line 6) * ISNAN: ISNAN. (line 6) -* ISO_FORTRAN_ENV statement: Fortran 2003 status. (line 130) +* ISO_FORTRAN_ENV statement: Fortran 2003 status. (line 128) +* IS_IOSTAT_END: IS_IOSTAT_END. (line 6) +* IS_IOSTAT_EOR: IS_IOSTAT_EOR. (line 6) * ITIME: ITIME. (line 6) +* JIABS: ABS. (line 6) +* JIAND: IAND. (line 6) +* JIBCLR: IBCLR. (line 6) +* JIBITS: IBITS. (line 6) +* JIBSET: IBSET. (line 6) +* JIEOR: IEOR. (line 6) +* JIOR: IOR. (line 6) +* JISHFT: ISHFT. (line 6) +* JISHFTC: ISHFTC. (line 6) +* JMOD: MOD. (line 6) +* JMVBITS: MVBITS. (line 6) +* JNOT: NOT. (line 6) +* KIABS: ABS. (line 6) +* KIAND: IAND. (line 6) +* KIBCLR: IBCLR. (line 6) +* KIBITS: IBITS. (line 6) +* KIBSET: IBSET. (line 6) +* KIEOR: IEOR. (line 6) * KILL: KILL. (line 6) -* kind: KIND. (line 6) -* KIND: KIND. (line 6) * kind: KIND Type Parameters. (line 6) +* KIND: KIND. (line 6) +* kind <1>: KIND. (line 6) * kind, character: SELECTED_CHAR_KIND. (line 6) * kind, integer: SELECTED_INT_KIND. (line 6) * kind, old-style: Old-style kind specifications. (line 6) * kind, real: SELECTED_REAL_KIND. (line 6) +* KIOR: IOR. (line 6) +* KISHFT: ISHFT. (line 6) +* KISHFTC: ISHFTC. (line 6) +* KMOD: MOD. (line 6) +* KMVBITS: MVBITS. (line 6) +* KNOT: NOT. (line 6) * L2 vector norm: NORM2. (line 6) * language, dialect options: Fortran Dialect Options. (line 6) @@ -20213,14 +21600,15 @@ Keyword Index * left shift, combined: DSHIFTL. (line 6) * LEN: LEN. (line 6) * LEN_TRIM: LEN_TRIM. (line 6) -* lexical comparison of strings <1>: LLT. (line 6) -* lexical comparison of strings <2>: LLE. (line 6) -* lexical comparison of strings <3>: LGT. (line 6) * lexical comparison of strings: LGE. (line 6) +* lexical comparison of strings <1>: LGT. (line 6) +* lexical comparison of strings <2>: LLE. (line 6) +* lexical comparison of strings <3>: LLT. (line 6) * LGAMMA: LOG_GAMMA. (line 6) * LGE: LGE. (line 6) * LGT: LGT. (line 6) * libf2c calling convention: Code Gen Options. (line 25) +* libf2c calling convention <1>: Code Gen Options. (line 110) * libgfortran initialization, set_args: _gfortran_set_args. (line 6) * libgfortran initialization, set_convert: _gfortran_set_convert. (line 6) @@ -20238,25 +21626,28 @@ Keyword Index * LLE: LLE. (line 6) * LLT: LLT. (line 6) * LNBLNK: LNBLNK. (line 6) -* LOC: LOC. (line 6) +* LOC: %LOC as an rvalue. (line 6) +* LOC <1>: LOC. (line 6) * location of a variable in memory: LOC. (line 6) * LOG: LOG. (line 6) * LOG10: LOG10. (line 6) -* LOG_GAMMA: LOG_GAMMA. (line 6) * logarithm function: LOG. (line 6) * logarithm function with base 10: LOG10. (line 6) * logarithm function, inverse: EXP. (line 6) * LOGICAL: LOGICAL. (line 6) -* logical and, bitwise <1>: IAND. (line 6) * logical and, bitwise: AND. (line 6) -* logical exclusive or, bitwise <1>: XOR. (line 6) +* logical and, bitwise <1>: IAND. (line 6) * logical exclusive or, bitwise: IEOR. (line 6) +* logical exclusive or, bitwise <1>: XOR. (line 6) * logical not, bitwise: NOT. (line 6) -* logical or, bitwise <1>: OR. (line 6) * logical or, bitwise: IOR. (line 6) +* logical or, bitwise <1>: OR. (line 6) +* logical, bitwise: Bitwise logical operators. + (line 6) * logical, variable representation: Internal representation of LOGICAL variables. (line 6) * login name: GETLOG. (line 6) +* LOG_GAMMA: LOG_GAMMA. (line 6) * LONG: LONG. (line 6) * LSHIFT: LSHIFT. (line 6) * LSTAT: LSTAT. (line 6) @@ -20274,13 +21665,13 @@ Keyword Index * MAX0: MAX. (line 6) * MAX1: MAX. (line 6) * MAXEXPONENT: MAXEXPONENT. (line 6) -* maximum value <1>: MAXVAL. (line 6) * maximum value: MAX. (line 6) +* maximum value <1>: MAXVAL. (line 6) * MAXLOC: MAXLOC. (line 6) * MAXVAL: MAXVAL. (line 6) * MCLOCK: MCLOCK. (line 6) * MCLOCK8: MCLOCK8. (line 6) -* memory checking: Code Gen Options. (line 143) +* memory checking: Code Gen Options. (line 141) * MERGE: MERGE. (line 6) * MERGE_BITS: MERGE_BITS. (line 6) * messages, error: Error and Warning Options. @@ -20291,8 +21682,8 @@ Keyword Index * MIN0: MIN. (line 6) * MIN1: MIN. (line 6) * MINEXPONENT: MINEXPONENT. (line 6) -* minimum value <1>: MINVAL. (line 6) * minimum value: MIN. (line 6) +* minimum value <1>: MINVAL. (line 6) * MINLOC: MINLOC. (line 6) * MINVAL: MINVAL. (line 6) * Mixed-language programming: Mixed-Language Programming. @@ -20309,10 +21700,12 @@ Keyword Index * model representation, significant digits: DIGITS. (line 6) * model representation, smallest number: TINY. (line 6) * module entities: Fortran Dialect Options. - (line 68) + (line 86) * module search path: Directory Options. (line 14) -* modulo: MODULO. (line 6) +* module search path <1>: Directory Options. (line 29) +* module search path <2>: Directory Options. (line 36) * MODULO: MODULO. (line 6) +* modulo: MODULO. (line 6) * MOVE_ALLOC: MOVE_ALLOC. (line 6) * moving allocation: MOVE_ALLOC. (line 6) * multiply array elements: PRODUCT. (line 6) @@ -20322,23 +21715,26 @@ Keyword Index (line 6) * natural logarithm function: LOG. (line 6) * NEAREST: NEAREST. (line 6) -* NEW_LINE: NEW_LINE. (line 6) * newline: NEW_LINE. (line 6) +* NEW_LINE: NEW_LINE. (line 6) * NINT: NINT. (line 6) * norm, Euclidean: NORM2. (line 6) * NORM2: NORM2. (line 6) +* NOSHARED: Extended I/O specifiers. + (line 6) * NOT: NOT. (line 6) * NULL: NULL. (line 6) * NUM_IMAGES: NUM_IMAGES. (line 6) * open, action: Files opened without an explicit ACTION= specifier. (line 6) -* OpenACC <1>: OpenACC. (line 6) * OpenACC: Fortran Dialect Options. - (line 106) -* OpenMP <1>: OpenMP. (line 6) + (line 124) +* OpenACC <1>: OpenACC. (line 6) * OpenMP: Fortran Dialect Options. - (line 118) + (line 135) +* OpenMP <1>: OpenMP. (line 6) * operators, unary: Unary operators. (line 6) +* operators, xor: .XOR. operator. (line 6) * options inquiry function: COMPILER_OPTIONS. (line 6) * options, code generation: Code Gen Options. (line 6) * options, debugging: Debugging Options. (line 6) @@ -20357,7 +21753,7 @@ Keyword Index * options, preprocessor: Preprocessing Options. (line 6) * options, real kind type promotion: Fortran Dialect Options. - (line 177) + (line 193) * options, run-time: Code Gen Options. (line 6) * options, runtime: Runtime Options. (line 6) * options, warnings: Error and Warning Options. @@ -20365,22 +21761,26 @@ Keyword Index * OR: OR. (line 6) * output, newline: NEW_LINE. (line 6) * PACK: PACK. (line 6) -* parity: POPPAR. (line 6) -* Parity: PARITY. (line 6) +* PARAMETER: Legacy PARAMETER statements. + (line 6) * PARITY: PARITY. (line 6) +* Parity: PARITY. (line 6) +* parity: POPPAR. (line 6) * paths, search: Directory Options. (line 14) +* paths, search <1>: Directory Options. (line 29) +* paths, search <2>: Directory Options. (line 36) * PERROR: PERROR. (line 6) -* pointer checking: Code Gen Options. (line 143) +* pointer checking: Code Gen Options. (line 141) * pointer, C address of pointers: C_F_PROCPOINTER. (line 6) * pointer, C address of procedures: C_FUNLOC. (line 6) * pointer, C association status: C_ASSOCIATED. (line 6) * pointer, convert C to Fortran: C_F_POINTER. (line 6) -* pointer, cray <1>: MALLOC. (line 6) -* pointer, cray: FREE. (line 6) * pointer, Cray: Cray pointers. (line 6) +* pointer, cray: FREE. (line 6) +* pointer, cray <1>: MALLOC. (line 6) * pointer, disassociated: NULL. (line 6) -* pointer, status <1>: NULL. (line 6) * pointer, status: ASSOCIATED. (line 6) +* pointer, status <1>: NULL. (line 6) * POPCNT: POPCNT. (line 6) * POPPAR: POPPAR. (line 6) * positive difference: DIM. (line 6) @@ -20388,21 +21788,45 @@ Keyword Index * Preprocessing: Preprocessing and conditional compilation. (line 6) * preprocessing, assertion: Preprocessing Options. - (line 114) + (line 113) +* preprocessing, assertion <1>: Preprocessing Options. + (line 119) * preprocessing, define macros: Preprocessing Options. - (line 153) + (line 151) +* preprocessing, define macros <1>: Preprocessing Options. + (line 154) * preprocessing, include path: Preprocessing Options. - (line 70) + (line 69) +* preprocessing, include path <1>: Preprocessing Options. + (line 76) +* preprocessing, include path <2>: Preprocessing Options. + (line 80) +* preprocessing, include path <3>: Preprocessing Options. + (line 85) +* preprocessing, include path <4>: Preprocessing Options. + (line 89) +* preprocessing, include path <5>: Preprocessing Options. + (line 96) * preprocessing, keep comments: Preprocessing Options. - (line 123) + (line 122) +* preprocessing, keep comments <1>: Preprocessing Options. + (line 137) * preprocessing, no linemarkers: Preprocessing Options. - (line 181) + (line 179) * preprocessing, undefine macros: Preprocessing Options. - (line 187) + (line 185) * preprocessor: Preprocessing Options. (line 6) * preprocessor, debugging: Preprocessing Options. (line 26) +* preprocessor, debugging <1>: Preprocessing Options. + (line 35) +* preprocessor, debugging <2>: Preprocessing Options. + (line 41) +* preprocessor, debugging <3>: Preprocessing Options. + (line 44) +* preprocessor, debugging <4>: Preprocessing Options. + (line 51) * preprocessor, disable: Preprocessing Options. (line 12) * preprocessor, enable: Preprocessing Options. @@ -20413,7 +21837,7 @@ Keyword Index (line 55) * PRESENT: PRESENT. (line 6) * private: Fortran Dialect Options. - (line 68) + (line 86) * procedure pointer, convert C to Fortran: C_LOC. (line 6) * process ID: GETPID. (line 6) * PRODUCT: PRODUCT. (line 6) @@ -20422,61 +21846,63 @@ Keyword Index * product, vector: DOT_PRODUCT. (line 6) * program termination: EXIT. (line 6) * program termination, with core dump: ABORT. (line 6) -* PROTECTED statement: Fortran 2003 status. (line 116) +* PROTECTED statement: Fortran 2003 status. (line 114) * Q exponent-letter: Q exponent-letter. (line 6) * RADIX: RADIX. (line 6) * radix, real: SELECTED_REAL_KIND. (line 6) * RAN: RAN. (line 6) * RAND: RAND. (line 6) -* random number generation <1>: RANDOM_NUMBER. (line 6) -* random number generation <2>: RAND. (line 6) -* random number generation <3>: RAN. (line 6) * random number generation: IRAND. (line 6) -* random number generation, seeding <1>: SRAND. (line 6) +* random number generation <1>: RAN. (line 6) +* random number generation <2>: RAND. (line 6) +* random number generation <3>: RANDOM_NUMBER. (line 6) * random number generation, seeding: RANDOM_SEED. (line 6) +* random number generation, seeding <1>: SRAND. (line 6) * RANDOM_NUMBER: RANDOM_NUMBER. (line 6) * RANDOM_SEED: RANDOM_SEED. (line 6) * RANGE: RANGE. (line 6) -* range checking: Code Gen Options. (line 143) -* rank: RANK. (line 6) +* range checking: Code Gen Options. (line 141) * RANK: RANK. (line 6) +* rank: RANK. (line 6) * re-association of parenthesized expressions: Code Gen Options. - (line 350) -* read character, stream mode <1>: FGETC. (line 6) + (line 346) * read character, stream mode: FGET. (line 6) +* read character, stream mode <1>: FGETC. (line 6) +* READONLY: Extended I/O specifiers. + (line 6) * REAL: REAL. (line 6) * real kind: SELECTED_REAL_KIND. (line 6) * real number, exponent: EXPONENT. (line 6) * real number, fraction: FRACTION. (line 6) * real number, nearest different: NEAREST. (line 6) -* real number, relative spacing <1>: SPACING. (line 6) * real number, relative spacing: RRSPACING. (line 6) +* real number, relative spacing <1>: SPACING. (line 6) * real number, scale: SCALE. (line 6) * real number, set exponent: SET_EXPONENT. (line 6) -* Reallocate the LHS in assignments: Code Gen Options. (line 359) +* Reallocate the LHS in assignments: Code Gen Options. (line 355) * Reallocate the LHS in assignments, notification: Error and Warning Options. - (line 220) + (line 232) * REALPART: REAL. (line 6) * RECORD: STRUCTURE and RECORD. (line 6) * Reduction, XOR: PARITY. (line 6) * remainder: MOD. (line 6) * RENAME: RENAME. (line 6) -* repacking arrays: Code Gen Options. (line 251) +* repacking arrays: Code Gen Options. (line 250) * REPEAT: REPEAT. (line 6) * RESHAPE: RESHAPE. (line 6) * REWIND: Read/Write after EOF marker. (line 6) * right shift, combined: DSHIFTR. (line 6) * root: SQRT. (line 6) -* rounding, ceiling <1>: CEILING. (line 6) * rounding, ceiling: ANINT. (line 6) -* rounding, floor <1>: FLOOR. (line 6) +* rounding, ceiling <1>: CEILING. (line 6) * rounding, floor: AINT. (line 6) +* rounding, floor <1>: FLOOR. (line 6) * rounding, nearest whole number: NINT. (line 6) * RRSPACING: RRSPACING. (line 6) * RSHIFT: RSHIFT. (line 6) -* run-time checking: Code Gen Options. (line 143) +* run-time checking: Code Gen Options. (line 141) * SAME_TYPE_AS: SAME_TYPE_AS. (line 6) * SAVE statement: Code Gen Options. (line 15) * SCALE: SCALE. (line 6) @@ -20485,17 +21911,21 @@ Keyword Index * search paths, for included files: Directory Options. (line 14) * SECNDS: SECNDS. (line 6) * SECOND: SECOND. (line 6) -* seeding a random number generator <1>: SRAND. (line 6) * seeding a random number generator: RANDOM_SEED. (line 6) +* seeding a random number generator <1>: SRAND. (line 6) * SELECTED_CHAR_KIND: SELECTED_CHAR_KIND. (line 6) * SELECTED_INT_KIND: SELECTED_INT_KIND. (line 6) * SELECTED_REAL_KIND: SELECTED_REAL_KIND. (line 6) * SET_EXPONENT: SET_EXPONENT. (line 6) * SHAPE: SHAPE. (line 6) -* shift, left <1>: SHIFTL. (line 6) +* SHARE: Extended I/O specifiers. + (line 6) +* SHARED: Extended I/O specifiers. + (line 6) * shift, left: DSHIFTL. (line 6) -* shift, right <1>: SHIFTR. (line 6) +* shift, left <1>: SHIFTL. (line 6) * shift, right: DSHIFTR. (line 6) +* shift, right <1>: SHIFTR. (line 6) * shift, right with fill: SHIFTA. (line 6) * SHIFTA: SHIFTA. (line 6) * SHIFTL: SHIFTL. (line 6) @@ -20505,15 +21935,18 @@ Keyword Index * sign copying: SIGN. (line 6) * SIGNAL: SIGNAL. (line 6) * SIN: SIN. (line 6) +* SIND: SIND. (line 6) * sine: SIN. (line 6) +* sine, degrees: SIND. (line 6) * sine, hyperbolic: SINH. (line 6) * sine, hyperbolic, inverse: ASINH. (line 6) * sine, inverse: ASIN. (line 6) +* sine, inverse, degrees: ASIND. (line 6) * SINH: SINH. (line 6) * SIZE: SIZE. (line 6) * size of a variable, in bits: BIT_SIZE. (line 6) -* size of an expression <1>: SIZEOF. (line 6) * size of an expression: C_SIZEOF. (line 6) +* size of an expression <1>: SIZEOF. (line 6) * SIZEOF: SIZEOF. (line 6) * SLEEP: SLEEP. (line 6) * SNGL: REAL. (line 6) @@ -20527,26 +21960,28 @@ Keyword Index * statement, ENUM: Fortran 2003 status. (line 93) * statement, ENUMERATOR: Fortran 2003 status. (line 93) * statement, FLUSH: Fortran 2003 status. (line 89) -* statement, IMPORT: Fortran 2003 status. (line 122) -* statement, ISO_FORTRAN_ENV: Fortran 2003 status. (line 130) -* statement, PROTECTED: Fortran 2003 status. (line 116) +* statement, IMPORT: Fortran 2003 status. (line 120) +* statement, ISO_FORTRAN_ENV: Fortran 2003 status. (line 128) +* statement, PROTECTED: Fortran 2003 status. (line 114) * statement, SAVE: Code Gen Options. (line 15) -* statement, USE, INTRINSIC: Fortran 2003 status. (line 130) -* statement, VALUE: Fortran 2003 status. (line 118) -* statement, VOLATILE: Fortran 2003 status. (line 120) +* statement, USE, INTRINSIC: Fortran 2003 status. (line 128) +* statement, VALUE: Fortran 2003 status. (line 116) +* statement, VOLATILE: Fortran 2003 status. (line 118) +* STATIC: AUTOMATIC and STATIC attributes. + (line 6) * storage size: STORAGE_SIZE. (line 6) * STORAGE_SIZE: STORAGE_SIZE. (line 6) -* STREAM I/O: Fortran 2003 status. (line 105) -* stream mode, read character <1>: FGETC. (line 6) +* STREAM I/O: Fortran 2003 status. (line 103) * stream mode, read character: FGET. (line 6) -* stream mode, write character <1>: FPUTC. (line 6) +* stream mode, read character <1>: FGETC. (line 6) * stream mode, write character: FPUT. (line 6) +* stream mode, write character <1>: FPUTC. (line 6) * string, adjust left: ADJUSTL. (line 6) * string, adjust right: ADJUSTR. (line 6) -* string, comparison <1>: LLT. (line 6) -* string, comparison <2>: LLE. (line 6) -* string, comparison <3>: LGT. (line 6) * string, comparison: LGE. (line 6) +* string, comparison <1>: LGT. (line 6) +* string, comparison <2>: LLE. (line 6) +* string, comparison <3>: LLT. (line 6) * string, concatenate: REPEAT. (line 6) * string, find missing set: VERIFY. (line 6) * string, find non-blank character: LNBLNK. (line 6) @@ -20560,46 +21995,52 @@ Keyword Index (line 6) * STRUCTURE: STRUCTURE and RECORD. (line 6) -* structure packing: Code Gen Options. (line 245) -* subscript checking: Code Gen Options. (line 143) +* structure packing: Code Gen Options. (line 244) +* subscript checking: Code Gen Options. (line 141) * substring position: INDEX intrinsic. (line 6) * SUM: SUM. (line 6) * sum array elements: SUM. (line 6) * suppressing warnings: Error and Warning Options. (line 6) * symbol names: Fortran Dialect Options. - (line 50) + (line 68) * symbol names, transforming: Code Gen Options. (line 54) +* symbol names, transforming <1>: Code Gen Options. (line 110) * symbol names, underscores: Code Gen Options. (line 54) +* symbol names, underscores <1>: Code Gen Options. (line 110) * SYMLNK: SYMLNK. (line 6) * syntax checking: Error and Warning Options. (line 33) * SYSTEM: SYSTEM. (line 6) -* system, error handling <1>: PERROR. (line 6) -* system, error handling <2>: IERRNO. (line 6) * system, error handling: GERROR. (line 6) +* system, error handling <1>: IERRNO. (line 6) +* system, error handling <2>: PERROR. (line 6) * system, group ID: GETGID. (line 6) * system, host name: HOSTNM. (line 6) * system, login name: GETLOG. (line 6) * system, process ID: GETPID. (line 6) * system, signal handling: SIGNAL. (line 6) -* system, system call <1>: SYSTEM. (line 6) * system, system call: EXECUTE_COMMAND_LINE. (line 6) -* system, terminal <1>: TTYNAM. (line 6) +* system, system call <1>: SYSTEM. (line 6) * system, terminal: ISATTY. (line 6) +* system, terminal <1>: TTYNAM. (line 6) * system, user ID: GETUID. (line 6) -* system, working directory <1>: GETCWD. (line 6) * system, working directory: CHDIR. (line 6) +* system, working directory <1>: GETCWD. (line 6) * SYSTEM_CLOCK: SYSTEM_CLOCK. (line 6) * tabulators: Error and Warning Options. - (line 175) + (line 182) * TAN: TAN. (line 6) +* TAND: TAND. (line 6) * tangent: TAN. (line 6) +* tangent, degrees: TAND. (line 6) * tangent, hyperbolic: TANH. (line 6) * tangent, hyperbolic, inverse: ATANH. (line 6) -* tangent, inverse <1>: ATAN2. (line 6) * tangent, inverse: ATAN. (line 6) +* tangent, inverse <1>: ATAN2. (line 6) +* tangent, inverse, degrees: ATAND. (line 6) +* tangent, inverse, degrees <1>: ATAN2D. (line 6) * TANH: TANH. (line 6) * terminate program: EXIT. (line 6) * terminate program, with core dump: ABORT. (line 6) @@ -20607,57 +22048,73 @@ Keyword Index * thread-safety, threads: Thread-safety of the runtime library. (line 6) * TIME: TIME. (line 6) -* time, clock ticks <1>: SYSTEM_CLOCK. (line 6) -* time, clock ticks <2>: MCLOCK8. (line 6) * time, clock ticks: MCLOCK. (line 6) +* time, clock ticks <1>: MCLOCK8. (line 6) +* time, clock ticks <2>: SYSTEM_CLOCK. (line 6) * time, conversion to GMT info: GMTIME. (line 6) * time, conversion to local time info: LTIME. (line 6) * time, conversion to string: CTIME. (line 6) -* time, current <1>: TIME8. (line 6) -* time, current <2>: TIME. (line 6) -* time, current <3>: ITIME. (line 6) -* time, current <4>: FDATE. (line 6) * time, current: DATE_AND_TIME. (line 6) -* time, elapsed <1>: SECOND. (line 6) -* time, elapsed <2>: SECNDS. (line 6) -* time, elapsed <3>: ETIME. (line 6) -* time, elapsed <4>: DTIME. (line 6) +* time, current <1>: FDATE. (line 6) +* time, current <2>: ITIME. (line 6) +* time, current <3>: TIME. (line 6) +* time, current <4>: TIME8. (line 6) * time, elapsed: CPU_TIME. (line 6) +* time, elapsed <1>: DTIME. (line 6) +* time, elapsed <2>: ETIME. (line 6) +* time, elapsed <3>: SECNDS. (line 6) +* time, elapsed <4>: SECOND. (line 6) * TIME8: TIME8. (line 6) * TINY: TINY. (line 6) * TR 15581: Fortran 2003 status. (line 98) -* trace: Debugging Options. (line 62) +* trace: Debugging Options. (line 61) * TRAILZ: TRAILZ. (line 6) * TRANSFER: TRANSFER. (line 6) * transforming symbol names: Code Gen Options. (line 54) -* transpose: TRANSPOSE. (line 6) +* transforming symbol names <1>: Code Gen Options. (line 110) * TRANSPOSE: TRANSPOSE. (line 6) +* transpose: TRANSPOSE. (line 6) * trigonometric function, cosine: COS. (line 6) +* trigonometric function, cosine, degrees: COSD. (line 6) * trigonometric function, cosine, inverse: ACOS. (line 6) +* trigonometric function, cosine, inverse, degrees: ACOSD. (line 6) +* trigonometric function, cotangent: COTAN. (line 6) +* trigonometric function, cotangent, degrees: COTAND. (line 6) * trigonometric function, sine: SIN. (line 6) +* trigonometric function, sine, degrees: SIND. (line 6) * trigonometric function, sine, inverse: ASIN. (line 6) +* trigonometric function, sine, inverse, degrees: ASIND. (line 6) * trigonometric function, tangent: TAN. (line 6) -* trigonometric function, tangent, inverse <1>: ATAN2. (line 6) +* trigonometric function, tangent, degrees: TAND. (line 6) * trigonometric function, tangent, inverse: ATAN. (line 6) +* trigonometric function, tangent, inverse <1>: ATAN2. (line 6) +* trigonometric function, tangent, inverse, degrees: ATAND. (line 6) +* trigonometric function, tangent, inverse, degrees <1>: ATAN2D. + (line 6) * TRIM: TRIM. (line 6) * TTYNAM: TTYNAM. (line 6) +* type alias print: TYPE as an alias for PRINT. + (line 6) * type cast: TRANSFER. (line 6) * UBOUND: UBOUND. (line 6) * UCOBOUND: UCOBOUND. (line 6) * UMASK: UMASK. (line 6) * underflow: Error and Warning Options. - (line 183) + (line 195) * underscore: Code Gen Options. (line 54) +* underscore <1>: Code Gen Options. (line 110) * UNION: UNION and MAP. (line 6) * UNLINK: UNLINK. (line 6) * UNPACK: UNPACK. (line 6) * unused dummy argument: Error and Warning Options. - (line 199) + (line 211) * unused parameter: Error and Warning Options. - (line 203) -* USE, INTRINSIC statement: Fortran 2003 status. (line 130) + (line 215) +* USE, INTRINSIC statement: Fortran 2003 status. (line 128) * user id: GETUID. (line 6) -* VALUE statement: Fortran 2003 status. (line 118) +* VALUE statement: Fortran 2003 status. (line 116) +* variable attributes: AUTOMATIC and STATIC attributes. + (line 6) * Varying length character strings: Varying Length Character Strings. (line 6) * Varying length strings: Varying Length Character Strings. @@ -20667,490 +22124,533 @@ Keyword Index * version of the compiler: COMPILER_VERSION. (line 6) * VOLATILE: Volatile COMMON blocks. (line 6) -* VOLATILE statement: Fortran 2003 status. (line 120) +* VOLATILE statement: Fortran 2003 status. (line 118) * warning, C binding type: Error and Warning Options. - (line 99) + (line 106) * warnings, aliasing: Error and Warning Options. - (line 69) + (line 71) * warnings, alignment of COMMON blocks: Error and Warning Options. - (line 210) + (line 222) * warnings, all: Error and Warning Options. - (line 61) + (line 62) * warnings, ampersand: Error and Warning Options. - (line 86) + (line 88) +* warnings, argument mismatch: Error and Warning Options. + (line 96) * warnings, array temporaries: Error and Warning Options. - (line 94) + (line 101) * warnings, character truncation: Error and Warning Options. - (line 106) + (line 113) * warnings, conversion: Error and Warning Options. - (line 115) + (line 122) +* warnings, conversion <1>: Error and Warning Options. + (line 126) * warnings, division of integers: Error and Warning Options. - (line 138) + (line 145) * warnings, extra: Error and Warning Options. - (line 123) + (line 130) * warnings, function elimination: Error and Warning Options. - (line 216) + (line 228) * warnings, implicit interface: Error and Warning Options. - (line 128) + (line 135) * warnings, implicit procedure: Error and Warning Options. - (line 134) + (line 141) * warnings, integer division: Error and Warning Options. - (line 138) + (line 145) +* warnings, interface mismatch: Error and Warning Options. + (line 96) * warnings, intrinsic: Error and Warning Options. - (line 188) + (line 200) * warnings, intrinsics of other standards: Error and Warning Options. - (line 142) + (line 149) * warnings, line truncation: Error and Warning Options. - (line 109) + (line 116) * warnings, non-standard intrinsics: Error and Warning Options. - (line 142) -* warnings, q exponent-letter: Error and Warning Options. (line 149) +* warnings, parameter mismatch: Error and Warning Options. + (line 96) +* warnings, q exponent-letter: Error and Warning Options. + (line 156) * warnings, suppressing: Error and Warning Options. (line 6) * warnings, suspicious code: Error and Warning Options. - (line 153) + (line 160) * warnings, tabs: Error and Warning Options. - (line 175) + (line 182) * warnings, to errors: Error and Warning Options. - (line 250) + (line 261) +* warnings, undefined do loop: Error and Warning Options. + (line 190) * warnings, underflow: Error and Warning Options. - (line 183) + (line 195) * warnings, unused dummy argument: Error and Warning Options. - (line 199) + (line 211) * warnings, unused parameter: Error and Warning Options. - (line 203) + (line 215) * warnings, use statements: Error and Warning Options. - (line 195) -* write character, stream mode <1>: FPUTC. (line 6) + (line 207) * write character, stream mode: FPUT. (line 6) +* write character, stream mode <1>: FPUTC. (line 6) * XOR: XOR. (line 6) * XOR reduction: PARITY. (line 6) * ZABS: ABS. (line 6) * ZCOS: COS. (line 6) -* zero bits <1>: TRAILZ. (line 6) +* ZCOSD: COSD. (line 6) * zero bits: LEADZ. (line 6) +* zero bits <1>: TRAILZ. (line 6) * ZEXP: EXP. (line 6) * ZLOG: LOG. (line 6) * ZSIN: SIN. (line 6) +* ZSIND: SIND. (line 6) * ZSQRT: SQRT. (line 6) Tag Table: -Node: Top2004 -Node: Introduction3415 -Node: About GNU Fortran4164 -Node: GNU Fortran and GCC8153 -Node: Preprocessing and conditional compilation10267 -Node: GNU Fortran and G7711911 -Node: Project Status12484 -Node: Standards15214 -Node: Varying Length Character Strings16532 -Node: Invoking GNU Fortran17283 -Node: Option Summary19006 -Node: Fortran Dialect Options22505 -Node: Preprocessing Options32465 -Node: Error and Warning Options40696 -Node: Debugging Options51389 -Node: Directory Options54861 -Node: Link Options56296 -Node: Runtime Options56920 -Node: Code Gen Options58825 -Node: Environment Variables76128 -Node: Runtime76733 -Node: TMPDIR77835 -Node: GFORTRAN_STDIN_UNIT78504 -Node: GFORTRAN_STDOUT_UNIT78886 -Node: GFORTRAN_STDERR_UNIT79287 -Node: GFORTRAN_UNBUFFERED_ALL79689 -Node: GFORTRAN_UNBUFFERED_PRECONNECTED80220 -Node: GFORTRAN_SHOW_LOCUS80864 -Node: GFORTRAN_OPTIONAL_PLUS81360 -Node: GFORTRAN_DEFAULT_RECL81836 -Node: GFORTRAN_LIST_SEPARATOR82325 -Node: GFORTRAN_CONVERT_UNIT82934 -Node: GFORTRAN_ERROR_BACKTRACE85797 -Node: Fortran 2003 and 2008 status86354 -Node: Fortran 2003 status86634 -Node: Fortran 2008 status91875 -Node: TS 29113 status97249 -Node: TS 18508 status98250 -Node: Compiler Characteristics98950 -Node: KIND Type Parameters99579 -Node: Internal representation of LOGICAL variables101008 -Node: Thread-safety of the runtime library101868 -Node: Data consistency and durability104272 -Node: Files opened without an explicit ACTION= specifier107373 -Node: File operations on symbolic links108067 -Node: Extensions109136 -Node: Extensions implemented in GNU Fortran109741 -Node: Old-style kind specifications111186 -Node: Old-style variable initialization112293 -Node: Extensions to namelist113605 -Node: X format descriptor without count field115907 -Node: Commas in FORMAT specifications116434 -Node: Missing period in FORMAT specifications116951 -Node: I/O item lists117513 -Node: `Q' exponent-letter117900 -Node: BOZ literal constants118500 -Node: Real array indices121079 -Node: Unary operators121378 -Node: Implicitly convert LOGICAL and INTEGER values121792 -Node: Hollerith constants support122752 -Node: Cray pointers124524 -Node: CONVERT specifier129971 -Node: OpenMP131969 -Node: OpenACC134227 -Node: Argument list functions135537 -Node: Read/Write after EOF marker137181 -Node: STRUCTURE and RECORD137783 -Node: UNION and MAP142274 -Node: Extensions not implemented in GNU Fortran145195 -Node: ENCODE and DECODE statements146140 -Node: Variable FORMAT expressions147471 -Node: Alternate complex function syntax148576 -Node: Volatile COMMON blocks149127 -Node: OPEN( ... NAME=)149628 -Node: Mixed-Language Programming150029 -Node: Interoperability with C150612 -Node: Intrinsic Types151950 -Node: Derived Types and struct152946 -Node: Interoperable Global Variables154303 -Node: Interoperable Subroutines and Functions155579 -Node: Working with Pointers159375 -Node: Further Interoperability of Fortran with C163851 -Node: GNU Fortran Compiler Directives167200 -Node: Non-Fortran Main Program170454 -Node: _gfortran_set_args172644 -Node: _gfortran_set_options173579 -Node: _gfortran_set_convert176946 -Node: _gfortran_set_record_marker177810 -Node: _gfortran_set_fpe178618 -Node: _gfortran_set_max_subrecord_length179810 -Node: Naming and argument-passing conventions180730 -Node: Naming conventions181449 -Node: Argument passing conventions182919 -Node: Coarray Programming187415 -Node: Type and enum ABI Documentation187662 -Node: caf_token_t187904 -Node: caf_register_t188139 -Node: Function ABI Documentation188593 -Node: _gfortran_caf_init190336 -Node: _gfortran_caf_finish191773 -Node: _gfortran_caf_this_image192712 -Node: _gfortran_caf_num_images193463 -Node: _gfortran_caf_register194564 -Node: _gfortran_caf_deregister197748 -Node: _gfortran_caf_send198813 -Node: _gfortran_caf_get201607 -Node: _gfortran_caf_sendget204276 -Node: _gfortran_caf_lock207692 -Node: _gfortran_caf_unlock209411 -Node: _gfortran_caf_event_post210844 -Node: _gfortran_caf_event_wait212243 -Node: _gfortran_caf_event_query214290 -Node: _gfortran_caf_sync_all215582 -Node: _gfortran_caf_sync_images216496 -Node: _gfortran_caf_sync_memory217993 -Node: _gfortran_caf_error_stop218965 -Node: _gfortran_caf_error_stop_str219561 -Node: _gfortran_caf_atomic_define220229 -Node: _gfortran_caf_atomic_ref221489 -Node: _gfortran_caf_atomic_cas222769 -Node: _gfortran_caf_atomic_op224465 -Node: _gfortran_caf_co_broadcast226496 -Node: _gfortran_caf_co_max227561 -Node: _gfortran_caf_co_min229111 -Node: _gfortran_caf_co_sum230655 -Node: _gfortran_caf_co_reduce232111 -Node: Intrinsic Procedures234602 -Node: Introduction to Intrinsics251155 -Node: ABORT253507 -Node: ABS254253 -Node: ACCESS255870 -Node: ACHAR257791 -Node: ACOS258992 -Node: ACOSH260229 -Node: ADJUSTL261217 -Node: ADJUSTR262158 -Node: AIMAG263105 -Node: AINT264486 -Node: ALARM266073 -Node: ALL267707 -Node: ALLOCATED269625 -Node: AND270762 -Node: ANINT272059 -Node: ANY273537 -Node: ASIN275467 -Node: ASINH276693 -Node: ASSOCIATED277691 -Node: ATAN280696 -Node: ATAN2282115 -Node: ATANH283887 -Node: ATOMIC_ADD284884 -Node: ATOMIC_AND286423 -Node: ATOMIC_CAS288018 -Node: ATOMIC_DEFINE289881 -Node: ATOMIC_FETCH_ADD291588 -Node: ATOMIC_FETCH_AND293375 -Node: ATOMIC_FETCH_OR295171 -Node: ATOMIC_FETCH_XOR296959 -Node: ATOMIC_OR298748 -Node: ATOMIC_REF300340 -Node: ATOMIC_XOR302242 -Node: BACKTRACE303834 -Node: BESSEL_J0304413 -Node: BESSEL_J1305421 -Node: BESSEL_JN306430 -Node: BESSEL_Y0308312 -Node: BESSEL_Y1309258 -Node: BESSEL_YN310204 -Node: BGE312036 -Node: BGT312725 -Node: BIT_SIZE313372 -Node: BLE314193 -Node: BLT314872 -Node: BTEST315507 -Node: C_ASSOCIATED316390 -Node: C_F_POINTER317599 -Node: C_F_PROCPOINTER319023 -Node: C_FUNLOC320524 -Node: C_LOC321893 -Node: C_SIZEOF323170 -Node: CEILING324580 -Node: CHAR325585 -Node: CHDIR326789 -Node: CHMOD327957 -Node: CMPLX329820 -Node: CO_BROADCAST331274 -Node: CO_MAX333038 -Node: CO_MIN334910 -Node: CO_REDUCE336768 -Node: CO_SUM340245 -Node: COMMAND_ARGUMENT_COUNT342144 -Node: COMPILER_OPTIONS343068 -Node: COMPILER_VERSION344094 -Node: COMPLEX345058 -Node: CONJG346195 -Node: COS347266 -Node: COSH348712 -Node: COUNT349877 -Node: CPU_TIME351893 -Node: CSHIFT353247 -Node: CTIME354903 -Node: DATE_AND_TIME356413 -Node: DBLE358873 -Node: DCMPLX359666 -Node: DIGITS360860 -Node: DIM361826 -Node: DOT_PRODUCT363084 -Node: DPROD364740 -Node: DREAL365657 -Node: DSHIFTL366323 -Node: DSHIFTR367643 -Node: DTIME368964 -Node: EOSHIFT371767 -Node: EPSILON373840 -Node: ERF374566 -Node: ERFC375340 -Node: ERFC_SCALED376144 -Node: ETIME376836 -Node: EVENT_QUERY379068 -Node: EXECUTE_COMMAND_LINE380666 -Node: EXIT383252 -Node: EXP384126 -Node: EXPONENT385399 -Node: EXTENDS_TYPE_OF386159 -Node: FDATE387012 -Node: FGET388494 -Node: FGETC390312 -Node: FLOOR392113 -Node: FLUSH393099 -Node: FNUM394976 -Node: FPUT395700 -Node: FPUTC397327 -Node: FRACTION399100 -Node: FREE400003 -Node: FSEEK400840 -Node: FSTAT403136 -Node: FTELL404218 -Node: GAMMA405198 -Node: GERROR406241 -Node: GETARG406962 -Node: GET_COMMAND408728 -Node: GET_COMMAND_ARGUMENT410094 -Node: GETCWD412130 -Node: GETENV413104 -Node: GET_ENVIRONMENT_VARIABLE414529 -Node: GETGID416682 -Node: GETLOG417219 -Node: GETPID418079 -Node: GETUID418809 -Node: GMTIME419325 -Node: HOSTNM420814 -Node: HUGE421732 -Node: HYPOT422453 -Node: IACHAR423273 -Node: IALL424453 -Node: IAND425930 -Node: IANY426914 -Node: IARGC428400 -Node: IBCLR429421 -Node: IBITS430082 -Node: IBSET430997 -Node: ICHAR431653 -Node: IDATE433825 -Node: IEOR434852 -Node: IERRNO435728 -Node: IMAGE_INDEX436277 -Node: INDEX intrinsic437301 -Node: INT438842 -Node: INT2440574 -Node: INT8441339 -Node: IOR442051 -Node: IPARITY442903 -Node: IRAND444427 -Node: IS_IOSTAT_END445783 -Node: IS_IOSTAT_EOR446880 -Node: ISATTY448007 -Node: ISHFT448790 -Node: ISHFTC449770 -Node: ISNAN450986 -Node: ITIME451734 -Node: KILL452759 -Node: KIND453663 -Node: LBOUND454508 -Node: LCOBOUND455841 -Node: LEADZ456971 -Node: LEN457831 -Node: LEN_TRIM459112 -Node: LGE460094 -Node: LGT461596 -Node: LINK463063 -Node: LLE464098 -Node: LLT465592 -Node: LNBLNK467052 -Node: LOC467828 -Node: LOG468559 -Node: LOG10469959 -Node: LOG_GAMMA470933 -Node: LOGICAL472022 -Node: LONG472830 -Node: LSHIFT473586 -Node: LSTAT474671 -Node: LTIME475865 -Node: MALLOC477276 -Node: MASKL478735 -Node: MASKR479498 -Node: MATMUL480264 -Node: MAX481353 -Node: MAXEXPONENT482852 -Node: MAXLOC483668 -Node: MAXVAL485687 -Node: MCLOCK487320 -Node: MCLOCK8488344 -Node: MERGE489577 -Node: MERGE_BITS490326 -Node: MIN491187 -Node: MINEXPONENT492688 -Node: MINLOC493318 -Node: MINVAL495337 -Node: MOD496989 -Node: MODULO498734 -Node: MOVE_ALLOC500034 -Node: MVBITS501063 -Node: NEAREST502122 -Node: NEW_LINE503218 -Node: NINT503989 -Node: NORM2505392 -Node: NOT506530 -Node: NULL507114 -Node: NUM_IMAGES508019 -Node: OR509729 -Node: PACK511013 -Node: PARITY513006 -Node: PERROR514221 -Node: POPCNT514842 -Node: POPPAR515713 -Node: PRECISION516764 -Node: PRESENT517650 -Node: PRODUCT518756 -Node: RADIX520281 -Node: RAN521093 -Node: RAND521549 -Node: RANDOM_NUMBER522881 -Node: RANDOM_SEED524598 -Node: RANGE528410 -Node: RANK529106 -Node: REAL529886 -Node: RENAME531661 -Node: REPEAT532680 -Node: RESHAPE533406 -Node: RRSPACING534875 -Node: RSHIFT535568 -Node: SAME_TYPE_AS536706 -Node: SCALE537536 -Node: SCAN538316 -Node: SECNDS539866 -Node: SECOND540954 -Node: SELECTED_CHAR_KIND541830 -Node: SELECTED_INT_KIND543421 -Node: SELECTED_REAL_KIND544596 -Node: SET_EXPONENT547262 -Node: SHAPE548258 -Node: SHIFTA549673 -Node: SHIFTL550634 -Node: SHIFTR551469 -Node: SIGN552305 -Node: SIGNAL553589 -Node: SIN555086 -Node: SINH556184 -Node: SIZE557180 -Node: SIZEOF558488 -Node: SLEEP560138 -Node: SPACING560698 -Node: SPREAD561711 -Node: SQRT562856 -Node: SRAND564210 -Node: STAT565443 -Node: STORAGE_SIZE568610 -Node: SUM569489 -Node: SYMLNK570972 -Node: SYSTEM572104 -Node: SYSTEM_CLOCK573355 -Node: TAN576182 -Node: TANH577154 -Node: THIS_IMAGE578311 -Node: TIME580600 -Node: TIME8581725 -Node: TINY582875 -Node: TRAILZ583475 -Node: TRANSFER584292 -Node: TRANSPOSE586326 -Node: TRIM587013 -Node: TTYNAM587870 -Node: UBOUND588785 -Node: UCOBOUND590175 -Node: UMASK591307 -Node: UNLINK591985 -Node: UNPACK592962 -Node: VERIFY594250 -Node: XOR595971 -Node: Intrinsic Modules597343 -Node: ISO_FORTRAN_ENV597632 -Node: ISO_C_BINDING602018 -Node: IEEE modules606209 -Node: OpenMP Modules OMP_LIB and OMP_LIB_KINDS607354 -Node: OpenACC Module OPENACC608898 -Node: Contributing609825 -Node: Contributors610679 -Node: Projects612346 -Node: Proposed Extensions613151 -Node: Copying615162 -Node: GNU Free Documentation License652726 -Node: Funding677869 -Node: Option Index680394 -Node: Keyword Index696298 +Node: Top1950 +Node: Introduction3361 +Node: About GNU Fortran4110 +Node: GNU Fortran and GCC8099 +Node: Preprocessing and conditional compilation10213 +Node: GNU Fortran and G7711858 +Node: Project Status12431 +Node: Standards15159 +Node: Varying Length Character Strings16517 +Node: Invoking GNU Fortran17269 +Node: Option Summary18992 +Node: Fortran Dialect Options22625 +Node: Preprocessing Options33380 +Node: Error and Warning Options41621 +Node: Debugging Options52789 +Node: Directory Options56257 +Node: Link Options57692 +Node: Runtime Options58318 +Node: Code Gen Options60225 +Node: Environment Variables77582 +Node: Runtime78187 +Node: TMPDIR79287 +Node: GFORTRAN_STDIN_UNIT79957 +Node: GFORTRAN_STDOUT_UNIT80339 +Node: GFORTRAN_STDERR_UNIT80740 +Node: GFORTRAN_UNBUFFERED_ALL81142 +Node: GFORTRAN_UNBUFFERED_PRECONNECTED81673 +Node: GFORTRAN_SHOW_LOCUS82317 +Node: GFORTRAN_OPTIONAL_PLUS82813 +Node: GFORTRAN_DEFAULT_RECL83289 +Node: GFORTRAN_LIST_SEPARATOR83777 +Node: GFORTRAN_CONVERT_UNIT84386 +Node: GFORTRAN_ERROR_BACKTRACE87241 +Node: Fortran 2003 and 2008 status87798 +Node: Fortran 2003 status88078 +Node: Fortran 2008 status93321 +Node: TS 29113 status98699 +Node: TS 18508 status99702 +Node: Compiler Characteristics100493 +Node: KIND Type Parameters101122 +Node: Internal representation of LOGICAL variables102550 +Node: Thread-safety of the runtime library103410 +Node: Data consistency and durability105813 +Node: Files opened without an explicit ACTION= specifier108926 +Node: File operations on symbolic links109617 +Node: Extensions110687 +Node: Extensions implemented in GNU Fortran111292 +Node: Old-style kind specifications113173 +Node: Old-style variable initialization114275 +Node: Extensions to namelist115587 +Node: X format descriptor without count field117890 +Node: Commas in FORMAT specifications118417 +Node: Missing period in FORMAT specifications118934 +Node: I/O item lists119496 +Node: Q exponent-letter119881 +Node: BOZ literal constants120479 +Node: Real array indices123058 +Node: Unary operators123357 +Node: Implicitly convert LOGICAL and INTEGER values123771 +Node: Hollerith constants support124730 +Node: Cray pointers126502 +Node: CONVERT specifier131949 +Node: OpenMP133944 +Node: OpenACC136202 +Node: Argument list functions137511 +Node: Read/Write after EOF marker139154 +Node: STRUCTURE and RECORD139757 +Node: UNION and MAP144348 +Node: Type variants for integer intrinsics147316 +Node: AUTOMATIC and STATIC attributes149211 +Node: Extended math intrinsics150745 +Node: Form feed as whitespace152541 +Node: TYPE as an alias for PRINT153087 +Node: %LOC as an rvalue153552 +Node: .XOR. operator154199 +Node: Bitwise logical operators154599 +Node: Extended I/O specifiers156100 +Node: Legacy PARAMETER statements159820 +Node: Default exponents160425 +Node: Extensions not implemented in GNU Fortran160777 +Node: ENCODE and DECODE statements161722 +Node: Variable FORMAT expressions163053 +Node: Alternate complex function syntax164158 +Node: Volatile COMMON blocks164708 +Node: OPEN( ... NAME=)165210 +Node: Mixed-Language Programming165612 +Node: Interoperability with C166192 +Node: Intrinsic Types167526 +Node: Derived Types and struct168522 +Node: Interoperable Global Variables169880 +Node: Interoperable Subroutines and Functions171155 +Node: Working with Pointers174949 +Node: Further Interoperability of Fortran with C179425 +Node: GNU Fortran Compiler Directives182779 +Node: Non-Fortran Main Program186031 +Node: _gfortran_set_args188219 +Node: _gfortran_set_options189157 +Node: _gfortran_set_convert192557 +Node: _gfortran_set_record_marker193425 +Node: _gfortran_set_fpe194235 +Node: _gfortran_set_max_subrecord_length195433 +Node: Naming and argument-passing conventions196356 +Node: Naming conventions197075 +Node: Argument passing conventions198547 +Node: Coarray Programming203041 +Node: Type and enum ABI Documentation203288 +Node: caf_token_t203586 +Node: caf_register_t203822 +Node: caf_deregister_t205033 +Node: caf_reference_t205535 +Node: caf_team_t209859 +Node: Function ABI Documentation210158 +Node: _gfortran_caf_init212608 +Node: _gfortran_caf_finish214034 +Node: _gfortran_caf_this_image214973 +Node: _gfortran_caf_num_images215728 +Node: _gfortran_caf_image_status216839 +Node: _gfortran_caf_failed_images217959 +Node: _gfortran_caf_stopped_images219129 +Node: _gfortran_caf_register220302 +Node: _gfortran_caf_deregister224467 +Node: _gfortran_caf_is_present226070 +Node: _gfortran_caf_send227149 +Node: _gfortran_caf_get230339 +Node: _gfortran_caf_sendget233420 +Node: _gfortran_caf_send_by_ref237331 +Node: _gfortran_caf_get_by_ref240679 +Node: _gfortran_caf_sendget_by_ref243941 +Node: _gfortran_caf_lock247719 +Node: _gfortran_caf_unlock249502 +Node: _gfortran_caf_event_post250980 +Node: _gfortran_caf_event_wait252426 +Node: _gfortran_caf_event_query254530 +Node: _gfortran_caf_sync_all255861 +Node: _gfortran_caf_sync_images256786 +Node: _gfortran_caf_sync_memory258318 +Node: _gfortran_caf_error_stop259307 +Node: _gfortran_caf_error_stop_str259915 +Node: _gfortran_caf_fail_image260621 +Node: _gfortran_caf_atomic_define261157 +Node: _gfortran_caf_atomic_ref262472 +Node: _gfortran_caf_atomic_cas263776 +Node: _gfortran_caf_atomic_op265537 +Node: _gfortran_caf_co_broadcast267639 +Node: _gfortran_caf_co_max268741 +Node: _gfortran_caf_co_min270364 +Node: _gfortran_caf_co_sum271981 +Node: _gfortran_caf_co_reduce273518 +Node: Intrinsic Procedures276159 +Node: Introduction to Intrinsics293215 +Node: ABORT295565 +Node: ABS296310 +Node: ACCESS298260 +Node: ACHAR300190 +Node: ACOS301394 +Node: ACOSD302680 +Node: ACOSH303992 +Node: ADJUSTL304988 +Node: ADJUSTR305930 +Node: AIMAG306880 +Node: AINT308252 +Node: ALARM309858 +Node: ALL311490 +Node: ALLOCATED313414 +Node: AND314553 +Node: ANINT315852 +Node: ANY317349 +Node: ASIN319275 +Node: ASIND320550 +Node: ASINH321848 +Node: ASSOCIATED322854 +Node: ATAN325865 +Node: ATAND327315 +Node: ATAN2328785 +Node: ATAN2D330648 +Node: ATANH332622 +Node: ATOMIC_ADD333628 +Node: ATOMIC_AND335160 +Node: ATOMIC_CAS336748 +Node: ATOMIC_DEFINE338607 +Node: ATOMIC_FETCH_ADD340326 +Node: ATOMIC_FETCH_AND342126 +Node: ATOMIC_FETCH_OR343916 +Node: ATOMIC_FETCH_XOR345693 +Node: ATOMIC_OR347476 +Node: ATOMIC_REF349061 +Node: ATOMIC_XOR350957 +Node: BACKTRACE352542 +Node: BESSEL_J0353122 +Node: BESSEL_J1354138 +Node: BESSEL_JN355155 +Node: BESSEL_Y0356980 +Node: BESSEL_Y1357935 +Node: BESSEL_YN358890 +Node: BGE360721 +Node: BGT361413 +Node: BIT_SIZE362063 +Node: BLE362885 +Node: BLT363567 +Node: BTEST364205 +Node: C_ASSOCIATED365662 +Node: C_F_POINTER366873 +Node: C_F_PROCPOINTER368308 +Node: C_FUNLOC369815 +Node: C_LOC371186 +Node: C_SIZEOF372465 +Node: CEILING373878 +Node: CHAR374886 +Node: CHDIR376098 +Node: CHMOD377272 +Node: CMPLX379187 +Node: CO_BROADCAST380630 +Node: CO_MAX382403 +Node: CO_MIN384283 +Node: CO_REDUCE386149 +Node: CO_SUM389652 +Node: COMMAND_ARGUMENT_COUNT391559 +Node: COMPILER_OPTIONS392476 +Node: COMPILER_VERSION393502 +Node: COMPLEX394466 +Node: CONJG395605 +Node: COS396661 +Node: COSD398116 +Node: COSH399565 +Node: COTAN400748 +Node: COTAND401887 +Node: COUNT403066 +Node: CPU_TIME405091 +Node: CSHIFT406448 +Node: CTIME408108 +Node: DATE_AND_TIME409616 +Node: DBLE412096 +Node: DCMPLX412891 +Node: DIGITS414073 +Node: DIM415040 +Node: DOT_PRODUCT416321 +Node: DPROD417964 +Node: DREAL418891 +Node: DSHIFTL419557 +Node: DSHIFTR420890 +Node: DTIME422224 +Node: EOSHIFT425039 +Node: EPSILON427112 +Node: ERF427839 +Node: ERFC428620 +Node: ERFC_SCALED429430 +Node: ETIME430123 +Node: EVENT_QUERY432362 +Node: EXECUTE_COMMAND_LINE433951 +Node: EXIT436546 +Node: EXP437424 +Node: EXPONENT438677 +Node: EXTENDS_TYPE_OF439441 +Node: FDATE440299 +Node: FGET441785 +Node: FGETC443612 +Node: FLOOR445420 +Node: FLUSH446409 +Node: FNUM448288 +Node: FPUT449013 +Node: FPUTC450647 +Node: FRACTION452428 +Node: FREE453332 +Node: FSEEK454175 +Node: FSTAT456481 +Node: FTELL457568 +Node: GAMMA458550 +Node: GERROR459604 +Node: GETARG460326 +Node: GET_COMMAND462099 +Node: GET_COMMAND_ARGUMENT463473 +Node: GETCWD465521 +Node: GETENV466501 +Node: GET_ENVIRONMENT_VARIABLE467933 +Node: GETGID470096 +Node: GETLOG470633 +Node: GETPID471495 +Node: GETUID472225 +Node: GMTIME472741 +Node: HOSTNM474501 +Node: HUGE475422 +Node: HYPOT476144 +Node: IACHAR476970 +Node: IALL478138 +Node: IAND479623 +Node: IANY481196 +Node: IARGC482690 +Node: IBCLR483711 +Node: IBITS484959 +Node: IBSET486463 +Node: ICHAR487706 +Node: IDATE489876 +Node: IEOR491176 +Node: IERRNO492642 +Node: IMAGE_INDEX493191 +Node: INDEX intrinsic494219 +Node: INT495745 +Node: INT2497504 +Node: INT8498272 +Node: IOR498987 +Node: IPARITY500429 +Node: IRAND501961 +Node: IS_IOSTAT_END503320 +Node: IS_IOSTAT_EOR504419 +Node: ISATTY505548 +Node: ISHFT506331 +Node: ISHFTC507900 +Node: ISNAN509707 +Node: ITIME510474 +Node: KILL511772 +Node: KIND512681 +Node: LBOUND513527 +Node: LCOBOUND514865 +Node: LEADZ516000 +Node: LEN516861 +Node: LEN_TRIM518157 +Node: LGE519145 +Node: LGT520658 +Node: LINK522136 +Node: LLE523175 +Node: LLT524675 +Node: LNBLNK526146 +Node: LOC526924 +Node: LOG527656 +Node: LOG10529001 +Node: LOG_GAMMA529991 +Node: LOGICAL531093 +Node: LONG531905 +Node: LSHIFT532663 +Node: LSTAT533749 +Node: LTIME534949 +Node: MALLOC536631 +Node: MASKL538093 +Node: MASKR538860 +Node: MATMUL539630 +Node: MAX540728 +Node: MAXEXPONENT542263 +Node: MAXLOC543080 +Node: MAXVAL545105 +Node: MCLOCK546745 +Node: MCLOCK8547768 +Node: MERGE548998 +Node: MERGE_BITS549750 +Node: MIN550615 +Node: MINEXPONENT552153 +Node: MINLOC552784 +Node: MINVAL554809 +Node: MOD556462 +Node: MODULO558626 +Node: MOVE_ALLOC559929 +Node: MVBITS560962 +Node: NEAREST562614 +Node: NEW_LINE563714 +Node: NINT564487 +Node: NORM2565908 +Node: NOT567050 +Node: NULL568220 +Node: NUM_IMAGES569128 +Node: OR570829 +Node: PACK572115 +Node: PARITY574123 +Node: PERROR575344 +Node: POPCNT575969 +Node: POPPAR576841 +Node: PRECISION577895 +Node: PRESENT578782 +Node: PRODUCT579894 +Node: RADIX581428 +Node: RAN582240 +Node: RAND582696 +Node: RANDOM_NUMBER584031 +Node: RANDOM_SEED585245 +Node: RANGE587694 +Node: RANK588375 +Node: REAL589156 +Node: RENAME591145 +Node: REPEAT592167 +Node: RESHAPE592895 +Node: RRSPACING594362 +Node: RSHIFT595055 +Node: SAME_TYPE_AS596195 +Node: SCALE597027 +Node: SCAN597808 +Node: SECNDS599366 +Node: SECOND600458 +Node: SELECTED_CHAR_KIND601334 +Node: SELECTED_INT_KIND602929 +Node: SELECTED_REAL_KIND604106 +Node: SET_EXPONENT606783 +Node: SHAPE607780 +Node: SHIFTA609204 +Node: SHIFTL610168 +Node: SHIFTR611005 +Node: SIGN611843 +Node: SIGNAL613069 +Node: SIN614575 +Node: SIND615666 +Node: SINH616995 +Node: SIZE618008 +Node: SIZEOF619327 +Node: SLEEP620982 +Node: SPACING621543 +Node: SPREAD622557 +Node: SQRT623708 +Node: SRAND625040 +Node: STAT626274 +Node: STORAGE_SIZE629442 +Node: SUM630321 +Node: SYMLNK631813 +Node: SYSTEM632948 +Node: SYSTEM_CLOCK634203 +Node: TAN637033 +Node: TAND638104 +Node: TANH639188 +Node: THIS_IMAGE640363 +Node: TIME642663 +Node: TIME8643834 +Node: TINY645033 +Node: TRAILZ645634 +Node: TRANSFER646452 +Node: TRANSPOSE648488 +Node: TRIM649178 +Node: TTYNAM650036 +Node: UBOUND650954 +Node: UCOBOUND652344 +Node: UMASK653481 +Node: UNLINK654163 +Node: UNPACK655143 +Node: VERIFY656438 +Node: XOR658167 +Node: Intrinsic Modules659540 +Node: ISO_FORTRAN_ENV659829 +Node: ISO_C_BINDING664232 +Node: IEEE modules667938 +Node: OpenMP Modules OMP_LIB and OMP_LIB_KINDS669081 +Node: OpenACC Module OPENACC670621 +Node: Contributing671548 +Node: Contributors672402 +Node: Projects674033 +Node: Proposed Extensions674840 +Node: Copying676850 +Node: GNU Free Documentation License714396 +Node: Funding739520 +Node: Option Index742046 +Node: Keyword Index759002 End Tag Table diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 4d288bafac..85afdda46e 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-2016 +@set copyrights-gfortran 1999-2017 @include gcc-common.texi @@ -536,7 +536,8 @@ The current status of the support is can be found in the and @ref{TS 18508 status} sections of the documentation. Additionally, the GNU Fortran compilers supports the OpenMP specification -(version 4.0, @url{http://openmp.org/@/wp/@/openmp-specifications/}). +(version 4.0 and most of the features of the 4.5 version, +@url{http://openmp.org/@/wp/@/openmp-specifications/}). There also is initial support for the OpenACC specification (targeting version 2.0, @uref{http://www.openacc.org/}). Note that this is an experimental feature, incomplete, and subject to @@ -1124,7 +1125,7 @@ of @code{BIND(C) procedures.} @item GNU Fortran's implementation for variables with @code{ASYNCHRONOUS} attribute is compatible with TS 29113. -@item Assumed types (@code{TYPE(*)}. +@item Assumed types (@code{TYPE(*)}). @item Assumed-rank (@code{DIMENSION(..)}). However, the array descriptor of the TS is not yet supported. @@ -1146,6 +1147,10 @@ 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 @@ -1437,7 +1442,8 @@ purely for backward compatibility with legacy compilers. By default, extensions, but to warn about the use of the latter. Specifying either @option{-std=f95}, @option{-std=f2003} or @option{-std=f2008} disables both types of extensions, and @option{-std=legacy} allows both -without warning. +without warning. The special compile flag @option{-fdec} enables additional +compatibility extensions along with those enabled by @option{-std=legacy}. @menu * Old-style kind specifications:: @@ -1461,6 +1467,17 @@ without warning. * Read/Write after EOF marker:: * STRUCTURE and RECORD:: * UNION and MAP:: +* Type variants for integer intrinsics:: +* AUTOMATIC and STATIC attributes:: +* Extended math intrinsics:: +* Form feed as whitespace:: +* TYPE as an alias for PRINT:: +* %LOC as an rvalue:: +* .XOR. operator:: +* Bitwise logical operators:: +* Extended I/O specifiers:: +* Legacy PARAMETER statements:: +* Default exponents:: @end menu @node Old-style kind specifications @@ -1987,7 +2004,7 @@ and environment variables that influence run-time behavior. GNU Fortran strives to be compatible to the @uref{http://openmp.org/wp/openmp-specifications/, -OpenMP Application Program Interface v4.0}. +OpenMP Application Program Interface v4.5}. To enable the processing of the OpenMP directive @code{!$omp} in free-form source code; the @code{c$omp}, @code{*$omp} and @code{!$omp} @@ -2126,9 +2143,10 @@ be disabled using -std=legacy. @cindex @code{RECORD} Record structures are a pre-Fortran-90 vendor extension to create -user-defined aggregate data types. GNU Fortran does not support -record structures, only Fortran 90's ``derived types'', which have -a different syntax. +user-defined aggregate data types. Support for record structures in GNU +Fortran can be enabled with the @option{-fdec-structure} compile flag. +If you have a choice, you should instead use Fortran 90's ``derived types'', +which have a different syntax. In many cases, record structures can easily be converted to derived types. To convert, replace @code{STRUCTURE /}@var{structure-name}@code{/} @@ -2367,6 +2385,348 @@ a.h === '.C' a.l === '.D' @end example +@node Type variants for integer intrinsics +@subsection Type variants for integer intrinsics +@cindex intrinsics, integer + +Similar to the D/C prefixes to real functions to specify the input/output +types, GNU Fortran offers B/I/J/K prefixes to integer functions for +compatibility with DEC programs. The types implied by each are: + +@example +@code{B} - @code{INTEGER(kind=1)} +@code{I} - @code{INTEGER(kind=2)} +@code{J} - @code{INTEGER(kind=4)} +@code{K} - @code{INTEGER(kind=8)} +@end example + +GNU Fortran supports these with the flag @option{-fdec-intrinsic-ints}. +Intrinsics for which prefixed versions are available and in what form are noted +in @ref{Intrinsic Procedures}. The complete list of supported intrinsics is +here: + +@multitable @columnfractions .2 .2 .2 .2 .2 + +@headitem Intrinsic @tab B @tab I @tab J @tab K + +@item @code{@ref{ABS}} + @tab @code{BABS} @tab @code{IIABS} @tab @code{JIABS} @tab @code{KIABS} +@item @code{@ref{BTEST}} + @tab @code{BBTEST} @tab @code{BITEST} @tab @code{BJTEST} @tab @code{BKTEST} +@item @code{@ref{IAND}} + @tab @code{BIAND} @tab @code{IIAND} @tab @code{JIAND} @tab @code{KIAND} +@item @code{@ref{IBCLR}} + @tab @code{BBCLR} @tab @code{IIBCLR} @tab @code{JIBCLR} @tab @code{KIBCLR} +@item @code{@ref{IBITS}} + @tab @code{BBITS} @tab @code{IIBITS} @tab @code{JIBITS} @tab @code{KIBITS} +@item @code{@ref{IBSET}} + @tab @code{BBSET} @tab @code{IIBSET} @tab @code{JIBSET} @tab @code{KIBSET} +@item @code{@ref{IEOR}} + @tab @code{BIEOR} @tab @code{IIEOR} @tab @code{JIEOR} @tab @code{KIEOR} +@item @code{@ref{IOR}} + @tab @code{BIOR} @tab @code{IIOR} @tab @code{JIOR} @tab @code{KIOR} +@item @code{@ref{ISHFT}} + @tab @code{BSHFT} @tab @code{IISHFT} @tab @code{JISHFT} @tab @code{KISHFT} +@item @code{@ref{ISHFTC}} + @tab @code{BSHFTC} @tab @code{IISHFTC} @tab @code{JISHFTC} @tab @code{KISHFTC} +@item @code{@ref{MOD}} + @tab @code{BMOD} @tab @code{IMOD} @tab @code{JMOD} @tab @code{KMOD} +@item @code{@ref{NOT}} + @tab @code{BNOT} @tab @code{INOT} @tab @code{JNOT} @tab @code{KNOT} +@item @code{@ref{REAL}} + @tab @code{--} @tab @code{FLOATI} @tab @code{FLOATJ} @tab @code{FLOATK} +@end multitable + +@node AUTOMATIC and STATIC attributes +@subsection @code{AUTOMATIC} and @code{STATIC} attributes +@cindex variable attributes +@cindex @code{AUTOMATIC} +@cindex @code{STATIC} + +With @option{-fdec-static} GNU Fortran supports the DEC extended attributes +@code{STATIC} and @code{AUTOMATIC} to provide explicit specification of entity +storage. These follow the syntax of the Fortran standard @code{SAVE} attribute. + +@code{STATIC} is exactly equivalent to @code{SAVE}, and specifies that +an entity should be allocated in static memory. As an example, @code{STATIC} +local variables will retain their values across multiple calls to a function. + +Entities marked @code{AUTOMATIC} will be stack automatic whenever possible. +@code{AUTOMATIC} is the default for local variables smaller than +@option{-fmax-stack-var-size}, unless @option{-fno-automatic} is given. This +attribute overrides @option{-fno-automatic}, @option{-fmax-stack-var-size}, and +blanket @code{SAVE} statements. + + +Examples: + +@example +subroutine f + integer, automatic :: i ! automatic variable + integer x, y ! static variables + save + ... +endsubroutine +@end example +@example +subroutine f + integer a, b, c, x, y, z + static :: x + save y + automatic z, c + ! a, b, c, and z are automatic + ! x and y are static +endsubroutine +@end example +@example +! Compiled with -fno-automatic +subroutine f + integer a, b, c, d + automatic :: a + ! a is automatic; b, c, and d are static +endsubroutine +@end example + +@node Extended math intrinsics +@subsection Extended math intrinsics +@cindex intrinsics, math +@cindex intrinsics, trigonometric functions + +GNU Fortran supports an extended list of mathematical intrinsics with the +compile flag @option{-fdec-math} for compatability with legacy code. +These intrinsics are described fully in @ref{Intrinsic Procedures} where it is +noted that they are extensions and should be avoided whenever possible. + +Specifically, @option{-fdec-math} enables the @ref{COTAN} intrinsic, and +trigonometric intrinsics which accept or produce values in degrees instead of +radians. Here is a summary of the new intrinsics: + +@multitable @columnfractions .5 .5 +@headitem Radians @tab Degrees +@item @code{@ref{ACOS}} @tab @code{@ref{ACOSD}}* +@item @code{@ref{ASIN}} @tab @code{@ref{ASIND}}* +@item @code{@ref{ATAN}} @tab @code{@ref{ATAND}}* +@item @code{@ref{ATAN2}} @tab @code{@ref{ATAN2D}}* +@item @code{@ref{COS}} @tab @code{@ref{COSD}}* +@item @code{@ref{COTAN}}* @tab @code{@ref{COTAND}}* +@item @code{@ref{SIN}} @tab @code{@ref{SIND}}* +@item @code{@ref{TAN}} @tab @code{@ref{TAND}}* +@end multitable + +* Enabled with @option{-fdec-math}. + +For advanced users, it may be important to know the implementation of these +functions. They are simply wrappers around the standard radian functions, which +have more accurate builtin versions. These functions convert their arguments +(or results) to degrees (or radians) by taking the value modulus 360 (or 2*pi) +and then multiplying it by a constant radian-to-degree (or degree-to-radian) +factor, as appropriate. The factor is computed at compile-time as 180/pi (or +pi/180). + +@node Form feed as whitespace +@subsection Form feed as whitespace +@cindex form feed whitespace + +Historically, legacy compilers allowed insertion of form feed characters ('\f', +ASCII 0xC) at the beginning of lines for formatted output to line printers, +though the Fortran standard does not mention this. GNU Fortran supports the +interpretation of form feed characters in source as whitespace for +compatibility. + +@node TYPE as an alias for PRINT +@subsection TYPE as an alias for PRINT +@cindex type alias print +For compatibility, GNU Fortran will interpret @code{TYPE} statements as +@code{PRINT} statements with the flag @option{-fdec}. With this flag asserted, +the following two examples are equivalent: + +@smallexample +TYPE *, 'hello world' +@end smallexample + +@smallexample +PRINT *, 'hello world' +@end smallexample + +@node %LOC as an rvalue +@subsection %LOC as an rvalue +@cindex LOC +Normally @code{%LOC} is allowed only in parameter lists. However the intrinsic +function @code{LOC} does the same thing, and is usable as the right-hand-side of +assignments. For compatibility, GNU Fortran supports the use of @code{%LOC} as +an alias for the builtin @code{LOC} with @option{-std=legacy}. With this +feature enabled the following two examples are equivalent: + +@smallexample +integer :: i, l +l = %loc(i) +call sub(l) +@end smallexample + +@smallexample +integer :: i +call sub(%loc(i)) +@end smallexample + +@node .XOR. operator +@subsection .XOR. operator +@cindex operators, xor + +GNU Fortran supports @code{.XOR.} as a logical operator with @code{-std=legacy} +for compatibility with legacy code. @code{.XOR.} is equivalent to +@code{.NEQV.}. That is, the output is true if and only if the inputs differ. + +@node Bitwise logical operators +@subsection Bitwise logical operators +@cindex logical, bitwise + +With @option{-fdec}, GNU Fortran relaxes the type constraints on +logical operators to allow integer operands, and performs the corresponding +bitwise operation instead. This flag is for compatibility only, and should be +avoided in new code. Consider: + +@smallexample + INTEGER :: i, j + i = z'33' + j = z'cc' + print *, i .AND. j +@end smallexample + +In this example, compiled with @option{-fdec}, GNU Fortran will +replace the @code{.AND.} operation with a call to the intrinsic +@code{@ref{IAND}} function, yielding the bitwise-and of @code{i} and @code{j}. + +Note that this conversion will occur if at least one operand is of integral +type. As a result, a logical operand will be converted to an integer when the +other operand is an integer in a logical operation. In this case, +@code{.TRUE.} is converted to @code{1} and @code{.FALSE.} to @code{0}. + +Here is the mapping of logical operator to bitwise intrinsic used with +@option{-fdec}: + +@multitable @columnfractions .25 .25 .5 +@headitem Operator @tab Intrinsic @tab Bitwise operation +@item @code{.NOT.} @tab @code{@ref{NOT}} @tab complement +@item @code{.AND.} @tab @code{@ref{IAND}} @tab intersection +@item @code{.OR.} @tab @code{@ref{IOR}} @tab union +@item @code{.NEQV.} @tab @code{@ref{IEOR}} @tab exclusive or +@item @code{.EQV.} @tab @code{@ref{NOT}(@ref{IEOR})} @tab complement of exclusive or +@end multitable + +@node Extended I/O specifiers +@subsection Extended I/O specifiers +@cindex @code{CARRIAGECONTROL} +@cindex @code{READONLY} +@cindex @code{SHARE} +@cindex @code{SHARED} +@cindex @code{NOSHARED} +@cindex I/O specifiers + +GNU Fortran supports the additional legacy I/O specifiers +@code{CARRIAGECONTROL}, @code{READONLY}, and @code{SHARE} with the +compile flag @option{-fdec}, for compatibility. + +@table @code +@item CARRIAGECONTROL +The @code{CARRIAGECONTROL} specifier allows a user to control line +termination settings between output records for an I/O unit. The specifier has +no meaning for readonly files. When @code{CARRAIGECONTROL} is specified upon +opening a unit for formatted writing, the exact @code{CARRIAGECONTROL} setting +determines what characters to write between output records. The syntax is: + +@smallexample +OPEN(..., CARRIAGECONTROL=cc) +@end smallexample + +Where @emph{cc} is a character expression that evaluates to one of the +following values: + +@multitable @columnfractions .2 .8 +@item @code{'LIST'} @tab One line feed between records (default) +@item @code{'FORTRAN'} @tab Legacy interpretation of the first character (see below) +@item @code{'NONE'} @tab No separator between records +@end multitable + +With @code{CARRIAGECONTROL='FORTRAN'}, when a record is written, the first +character of the input record is not written, and instead determines the output +record separator as follows: + +@multitable @columnfractions .3 .3 .4 +@headitem Leading character @tab Meaning @tab Output separating character(s) +@item @code{'+'} @tab Overprinting @tab Carriage return only +@item @code{'-'} @tab New line @tab Line feed and carriage return +@item @code{'0'} @tab Skip line @tab Two line feeds and carriage return +@item @code{'1'} @tab New page @tab Form feed and carriage return +@item @code{'$'} @tab Prompting @tab Line feed (no carriage return) +@item @code{CHAR(0)} @tab Overprinting (no advance) @tab None +@end multitable + +@item READONLY +The @code{READONLY} specifier may be given upon opening a unit, and is +equivalent to specifying @code{ACTION='READ'}, except that the file may not be +deleted on close (i.e. @code{CLOSE} with @code{STATUS="DELETE"}). The syntax +is: + +@smallexample +@code{OPEN(..., READONLY)} +@end smallexample + +@item SHARE +The @code{SHARE} specifier allows system-level locking on a unit upon opening +it for controlled access from multiple processes/threads. The @code{SHARE} +specifier has several forms: + +@smallexample +OPEN(..., SHARE=sh) +OPEN(..., SHARED) +OPEN(..., NOSHARED) +@end smallexample + +Where @emph{sh} in the first form is a character expression that evaluates to +a value as seen in the table below. The latter two forms are aliases +for particular values of @emph{sh}: + +@multitable @columnfractions .3 .3 .4 +@headitem Explicit form @tab Short form @tab Meaning +@item @code{SHARE='DENYRW'} @tab @code{NOSHARED} @tab Exclusive (write) lock +@item @code{SHARE='DENYNONE'} @tab @code{SHARED} @tab Shared (read) lock +@end multitable + +In general only one process may hold an exclusive (write) lock for a given file +at a time, whereas many processes may hold shared (read) locks for the same +file. + +The behavior of locking may vary with your operating system. On POSIX systems, +locking is implemented with @code{fcntl}. Consult your corresponding operating +system's manual pages for further details. Locking via @code{SHARE=} is not +supported on other systems. + +@end table + +@node Legacy PARAMETER statements +@subsection Legacy PARAMETER statements +@cindex PARAMETER + +For compatibility, GNU Fortran supports legacy PARAMETER statements without +parentheses with @option{-std=legacy}. A warning is emitted if used with +@option{-std=gnu}, and an error is acknowledged with a real Fortran standard +flag (@option{-std=f95}, etc...). These statements take the following form: + +@smallexample +implicit real (E) +parameter e = 2.718282 +real c +parameter c = 3.0e8 +@end smallexample + +@node Default exponents +@subsection Default exponents +@cindex exponent + +For compatibility, GNU Fortran supports a default exponent of zero in real +constants with @option{-fdec}. For example, @code{9e} would be +interpreted as @code{9e0}, rather than an error. + @node Extensions not implemented in GNU Fortran @section Extensions not implemented in GNU Fortran @@ -2390,10 +2750,8 @@ code that uses them running with the GNU Fortran compiler. * ENCODE and DECODE statements:: * Variable FORMAT expressions:: @c * Q edit descriptor:: -@c * AUTOMATIC statement:: @c * TYPE and ACCEPT I/O Statements:: -@c * .XOR. operator:: -@c * CARRIAGECONTROL, DEFAULTFILE, DISPOSE and RECORDTYPE I/O specifiers:: +@c * DEFAULTFILE, DISPOSE and RECORDTYPE I/O specifiers:: @c * Omitted arguments in procedure call:: * Alternate complex function syntax:: * Volatile COMMON blocks:: @@ -3517,6 +3875,9 @@ of such a type @menu * caf_token_t:: * caf_register_t:: +* caf_deregister_t:: +* caf_reference_t:: +* caf_team_t:: @end menu @node caf_token_t @@ -3538,11 +3899,152 @@ typedef enum caf_register_t { CAF_REGTYPE_LOCK_ALLOC, CAF_REGTYPE_CRITICAL, CAF_REGTYPE_EVENT_STATIC, - CAF_REGTYPE_EVENT_ALLOC + CAF_REGTYPE_EVENT_ALLOC, + CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY, + CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY } caf_register_t; @end verbatim +The values @code{CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY} and +@code{CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY} are for allocatable components +in derived type coarrays only. The first one sets up the token without +allocating memory for allocatable component. The latter one only allocates the +memory for an allocatable component in a derived type coarray. The token +needs to be setup previously by the REGISTER_ONLY. This allows to have +allocatable components un-allocated on some images. The status whether an +allocatable component is allocated on a remote image can be queried by +@code{_caf_is_present} which used internally by the @code{ALLOCATED} +intrinsic. + +@node caf_deregister_t +@subsection @code{caf_deregister_t} + +@verbatim +typedef enum caf_deregister_t { + CAF_DEREGTYPE_COARRAY_DEREGISTER, + CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY +} +caf_deregister_t; +@end verbatim + +Allows to specifiy the type of deregistration of a coarray object. The +@code{CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY} flag is only allowed for +allocatable components in derived type coarrays. + +@node caf_reference_t +@subsection @code{caf_reference_t} + +The structure used for implementing arbitrary reference chains. +A @code{CAF_REFERENCE_T} allows to specify a component reference or any kind +of array reference of any rank supported by gfortran. For array references all +kinds as known by the compiler/Fortran standard are supported indicated by +a @code{MODE}. + +@verbatim +typedef enum caf_ref_type_t { + /* Reference a component of a derived type, either regular one or an + allocatable or pointer type. For regular ones idx in caf_reference_t is + set to -1. */ + CAF_REF_COMPONENT, + /* Reference an allocatable array. */ + CAF_REF_ARRAY, + /* Reference a non-allocatable/non-pointer array. I.e., the coarray object + has no array descriptor associated and the addressing is done + completely using the ref. */ + CAF_REF_STATIC_ARRAY +} caf_ref_type_t; +@end verbatim + +@verbatim +typedef enum caf_array_ref_t { + /* No array ref. This terminates the array ref. */ + CAF_ARR_REF_NONE = 0, + /* Reference array elements given by a vector. Only for this mode + caf_reference_t.u.a.dim[i].v is valid. */ + CAF_ARR_REF_VECTOR, + /* A full array ref (:). */ + CAF_ARR_REF_FULL, + /* Reference a range on elements given by start, end and stride. */ + CAF_ARR_REF_RANGE, + /* Only a single item is referenced given in the start member. */ + CAF_ARR_REF_SINGLE, + /* An array ref of the kind (i:), where i is an arbitrary valid index in the + array. The index i is given in the start member. */ + CAF_ARR_REF_OPEN_END, + /* An array ref of the kind (:i), where the lower bound of the array ref + is given by the remote side. The index i is given in the end member. */ + CAF_ARR_REF_OPEN_START +} caf_array_ref_t; +@end verbatim + +@verbatim +/* References to remote components of a derived type. */ +typedef struct caf_reference_t { + /* A pointer to the next ref or NULL. */ + struct caf_reference_t *next; + /* The type of the reference. */ + /* caf_ref_type_t, replaced by int to allow specification in fortran FE. */ + int type; + /* The size of an item referenced in bytes. I.e. in an array ref this is + the factor to advance the array pointer with to get to the next item. + For component refs this gives just the size of the element referenced. */ + size_t item_size; + union { + struct { + /* The offset (in bytes) of the component in the derived type. + Unused for allocatable or pointer components. */ + ptrdiff_t offset; + /* The offset (in bytes) to the caf_token associated with this + component. NULL, when not allocatable/pointer ref. */ + ptrdiff_t caf_token_offset; + } c; + struct { + /* The mode of the array ref. See CAF_ARR_REF_*. */ + /* caf_array_ref_t, replaced by unsigend char to allow specification in + fortran FE. */ + unsigned char mode[GFC_MAX_DIMENSIONS]; + /* The type of a static array. Unset for array's with descriptors. */ + int static_array_type; + /* Subscript refs (s) or vector refs (v). */ + union { + struct { + /* The start and end boundary of the ref and the stride. */ + index_type start, end, stride; + } s; + struct { + /* nvec entries of kind giving the elements to reference. */ + void *vector; + /* The number of entries in vector. */ + size_t nvec; + /* The integer kind used for the elements in vector. */ + int kind; + } v; + } dim[GFC_MAX_DIMENSIONS]; + } a; + } u; +} caf_reference_t; +@end verbatim + +The references make up a single linked list of reference operations. The +@code{NEXT} member links to the next reference or NULL to indicate the end of +the chain. Component and array refs can be arbitrarly mixed as long as they +comply to the Fortran standard. + +@emph{NOTES} +The member @code{STATIC_ARRAY_TYPE} is used only when the @code{TYPE} is +@code{CAF_REF_STATIC_ARRAY}. The member gives the type of the data referenced. +Because no array descriptor is available for a descriptor-less array and +type conversion still needs to take place the type is transported here. + +At the moment @code{CAF_ARR_REF_VECTOR} is not implemented in the front end for +descriptor-less arrays. The library caf_single has untested support for it. + +@node caf_team_t +@subsection @code{caf_team_t} + +Opaque pointer to represent a team-handle. This type is a stand-in for the +future implementation of teams. It is about to change without further notice. @node Function ABI Documentation @section Function ABI Documentation @@ -3552,11 +4054,18 @@ caf_register_t; * _gfortran_caf_finish:: Finalization function * _gfortran_caf_this_image:: Querying the image number * _gfortran_caf_num_images:: Querying the maximal number of images +* _gfortran_caf_image_status :: Query the status of an image +* _gfortran_caf_failed_images :: Get an array of the indexes of the failed images +* _gfortran_caf_stopped_images :: Get an array of the indexes of the stopped images * _gfortran_caf_register:: Registering coarrays * _gfortran_caf_deregister:: Deregistering coarrays +* _gfortran_caf_is_present:: Query whether an allocatable or pointer component in a derived type coarray is allocated * _gfortran_caf_send:: Sending data from a local image to a remote image * _gfortran_caf_get:: Getting data from a remote image * _gfortran_caf_sendget:: Sending data between remote images +* _gfortran_caf_send_by_ref:: Sending data from a local image to a remote image using enhanced references +* _gfortran_caf_get_by_ref:: Getting data from a remote image using enhanced references +* _gfortran_caf_sendget_by_ref:: Sending data between remote images using enhanced references * _gfortran_caf_lock:: Locking a lock variable * _gfortran_caf_unlock:: Unlocking a lock variable * _gfortran_caf_event_post:: Post an event @@ -3567,6 +4076,7 @@ caf_register_t; * _gfortran_caf_sync_memory:: Wait for completion of segment-memory operations * _gfortran_caf_error_stop:: Error termination with exit code * _gfortran_caf_error_stop_str:: Error termination with string +* _gfortran_caf_fail_image :: Mark the image failed and end its execution * _gfortran_caf_atomic_define:: Atomic variable assignment * _gfortran_caf_atomic_ref:: Atomic variable reference * _gfortran_caf_atomic_cas:: Atomic compare and swap @@ -3588,7 +4098,7 @@ caf_register_t; This function is called at startup of the program before the Fortran main program, if the latter has been compiled with @option{-fcoarray=lib}. It takes as arguments the command-line arguments of the program. It is -permitted to pass to @code{NULL} pointers as argument; if non-@code{NULL}, +permitted to pass two @code{NULL} pointers as argument; if non-@code{NULL}, the library is permitted to modify the arguments. @item @emph{Syntax}: @@ -3605,7 +4115,7 @@ command-line arguments or @code{NULL}. @item @emph{NOTES} The function is modelled after the initialization function of the Message Passing Interface (MPI) specification. Due to the way coarray registration -works, it might not be the first call to the libaray. If the main program is +works, it might not be the first call to the library. If the main program is not written in Fortran and only a library uses coarrays, it can happen that this function is never called. Therefore, it is recommended that the library does not rely on the passed arguments and whether the call has been done. @@ -3648,7 +4158,7 @@ This function returns the current image number, which is a positive number. @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{distance} @tab As specified for the @code{this_image} intrinsic -in TS18508. Shall be a nonnegative number. +in TS18508. Shall be a non-negative number. @end multitable @item @emph{NOTES} @@ -3682,35 +4192,132 @@ Shall be positive. @item @emph{NOTES} This function follows TS18508. If the num_image intrinsic has no arguments, -the the compiler passes @code{distance=0} and @code{failed=-1} to the function. +then the compiler passes @code{distance=0} and @code{failed=-1} to the function. +@end table + + +@node _gfortran_caf_image_status +@subsection @code{_gfortran_caf_image_status} --- Query the status of an image +@cindex Coarray, _gfortran_caf_image_status + +@table @asis +@item @emph{Description}: +Get the status of the image given by the id @var{image} of the team given by +@var{team}. Valid results are zero, for image is ok, @code{STAT_STOPPED_IMAGE} +from the ISO_FORTRAN_ENV module to indicate that the image has been stopped and +@code{STAT_FAILED_IMAGE} also from ISO_FORTRAN_ENV to indicate that the image +has executed a @code{FAIL IMAGE} statement. + +@item @emph{Syntax}: +@code{int _gfortran_caf_image_status (int image, caf_team_t * team)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{image} @tab the positive scalar id of the image in the current TEAM. +@item @var{team} @tab optional; team on the which the inquiry is to be +performed. +@end multitable + +@item @emph{NOTES} +This function follows TS18508. Because team-functionality is not yet +implemented a null-pointer is passed for the @var{team} argument at the moment. +@end table + + +@node _gfortran_caf_failed_images +@subsection @code{_gfortran_caf_failed_images} --- Get an array of the indexes of the failed images +@cindex Coarray, _gfortran_caf_failed_images + +@table @asis +@item @emph{Description}: +Get an array of image indexes in the current @var{team} that have failed. The +array is sorted ascendingly. When @var{team} is not provided the current team +is to be used. When @var{kind} is provided then the resulting array is of that +integer kind else it is of default integer kind. The returns an unallocated +size zero array when no images have failed. + +@item @emph{Syntax}: +@code{int _gfortran_caf_failed_images (caf_team_t * team, int * kind)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{team} @tab optional; team on the which the inquiry is to be +performed. +@item @var{image} @tab optional; the kind of the resulting integer array. +@end multitable + +@item @emph{NOTES} +This function follows TS18508. Because team-functionality is not yet +implemented a null-pointer is passed for the @var{team} argument at the moment. +@end table + + +@node _gfortran_caf_stopped_images +@subsection @code{_gfortran_caf_stopped_images} --- Get an array of the indexes of the stopped images +@cindex Coarray, _gfortran_caf_stopped_images + +@table @asis +@item @emph{Description}: +Get an array of image indexes in the current @var{team} that have stopped. The +array is sorted ascendingly. When @var{team} is not provided the current team +is to be used. When @var{kind} is provided then the resulting array is of that +integer kind else it is of default integer kind. The returns an unallocated +size zero array when no images have failed. + +@item @emph{Syntax}: +@code{int _gfortran_caf_stopped_images (caf_team_t * team, int * kind)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{team} @tab optional; team on the which the inquiry is to be +performed. +@item @var{image} @tab optional; the kind of the resulting integer array. +@end multitable + +@item @emph{NOTES} +This function follows TS18508. Because team-functionality is not yet +implemented a null-pointer is passed for the @var{team} argument at the moment. @end table @node _gfortran_caf_register @subsection @code{_gfortran_caf_register} --- Registering coarrays -@cindex Coarray, _gfortran_caf_deregister +@cindex Coarray, _gfortran_caf_register @table @asis @item @emph{Description}: -Allocates memory for a coarray and creates a token to identify the coarray. The -function is called for both coarrays with @code{SAVE} attribute and using an -explicit @code{ALLOCATE} statement. If an error occurs and @var{STAT} is a +Registers memory for a coarray and creates a token to identify the coarray. The +routine is called for both coarrays with @code{SAVE} attribute and using an +explicit @code{ALLOCATE} statement. If an error occurs and @var{STAT} is a @code{NULL} pointer, the function shall abort with printing an error message and starting the error termination. If no error occurs and @var{STAT} is -present, it shall be set to zero. Otherwise, it shall be set to a positive +present, it shall be set to zero. Otherwise, it shall be set to a positive value and, if not-@code{NULL}, @var{ERRMSG} shall be set to a string describing -the failure. The function shall return a pointer to the requested memory -for the local image as a call to @code{malloc} would do. +the failure. The routine shall register the memory provided in the +@code{DATA}-component of the array descriptor @var{DESC}, when that component +is non-@code{NULL}, else it shall allocate sufficient memory and provide a +pointer to it in the @code{DATA}-component of @var{DESC}. The array descriptor +has rank zero, when a scalar object is to be registered and the array +descriptor may be invalid after the call to @code{_gfortran_caf_register}. +When an array is to be allocated the descriptor persists. For @code{CAF_REGTYPE_COARRAY_STATIC} and @code{CAF_REGTYPE_COARRAY_ALLOC}, the passed size is the byte size requested. For @code{CAF_REGTYPE_LOCK_STATIC}, @code{CAF_REGTYPE_LOCK_ALLOC} and @code{CAF_REGTYPE_CRITICAL} it is the array size or one for a scalar. +When @code{CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY} is used, then only a token +for an allocatable or pointer component is created. The @code{SIZE} parameter +is not used then. On the contrary when +@code{CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY} is specified, then the +@var{token} needs to be registered by a previous call with regtype +@code{CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY} and either the memory specified +in the @var{desc}'s data-ptr is registered or allocate when the data-ptr is +NULL. @item @emph{Syntax}: -@code{void *caf_register (size_t size, caf_register_t type, caf_token_t *token, -int *stat, char *errmsg, int errmsg_len)} +@code{void caf_register (size_t size, caf_register_t type, caf_token_t *token, +gfc_descriptor_t *desc, int *stat, char *errmsg, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 @@ -3718,6 +4325,7 @@ int *stat, char *errmsg, int errmsg_len)} allocated; for lock types and event types, the number of elements. @item @var{type} @tab one of the caf_register_t types. @item @var{token} @tab intent(out) An opaque pointer identifying the coarray. +@item @var{desc} @tab intent(inout) The (pseudo) array descriptor. @item @var{stat} @tab intent(out) For allocatable coarrays, stores the STAT=; may be NULL @item @var{errmsg} @tab intent(out) When an error occurs, this will be set to @@ -3733,12 +4341,12 @@ GCC does such that also nonallocatable coarrays the memory is allocated and no static memory is used. The token permits to identify the coarray; to the processor, the token is a nonaliasing pointer. The library can, for instance, store the base address of the coarray in the token, some handle or a more -complicated struct. +complicated struct. The library may also store the array descriptor +@var{DESC} when its rank is non-zero. -For normal coarrays, the returned pointer is used for accesses on the local -image. For lock types, the value shall only used for checking the allocation +For lock types, the value shall only used for checking the allocation status. Note that for critical blocks, the locking is only required on one -image; in the locking statement, the processor shall always pass always an +image; in the locking statement, the processor shall always pass an image index of one for critical-block lock variables (@code{CAF_REGTYPE_CRITICAL}). For lock types and critical-block variables, the initial value shall be unlocked (or, respecitively, not in critical @@ -3753,16 +4361,23 @@ be no event, e.g. zero. @table @asis @item @emph{Description}: -Called to free the memory of a coarray; the processor calls this function for -automatic and explicit deallocation. In case of an error, this function shall -fail with an error message, unless the @var{STAT} variable is not null. +Called to free or deregister the memory of a coarray; the processor calls this +function for automatic and explicit deallocation. In case of an error, this +function shall fail with an error message, unless the @var{STAT} variable is +not null. The library is only expected to free memory it allocated itself +during a call to @code{_gfortran_caf_register}. @item @emph{Syntax}: -@code{void caf_deregister (const caf_token_t *token, int *stat, char *errmsg, -int errmsg_len)} +@code{void caf_deregister (caf_token_t *token, caf_deregister_t type, +int *stat, char *errmsg, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 +@item @var{token} @tab the token to free. +@item @var{type} @tab the type of action to take for the coarray. A +@code{CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY} is allowed only for allocatable or +pointer components of derived type coarrays. The action only deallocates the +local memory without deleting the token. @item @var{stat} @tab intent(out) Stores the STAT=; may be NULL @item @var{errmsg} @tab intent(out) When an error occurs, this will be set to an error message; may be NULL @@ -3776,46 +4391,75 @@ and via destructors. @end table +@node _gfortran_caf_is_present +@subsection @code{_gfortran_caf_is_present} --- Query whether an allocatable or pointer component in a derived type coarray is allocated +@cindex Coarray, _gfortran_caf_is_present + +@table @asis +@item @emph{Description}: +Used to query the coarray library whether an allocatable component in a derived +type coarray is allocated on a remote image. + +@item @emph{Syntax}: +@code{void _gfortran_caf_is_present (caf_token_t token, int image_index, +gfc_reference_t *ref)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{token} @tab An opaque pointer identifying the coarray. +@item @var{image_index} @tab The ID of the remote image; must be a positive +number. +@item @var{ref} @tab A chain of references to address the allocatable or +pointer component in the derived type coarray. The object reference needs to be +a scalar or a full array reference, respectively. +@end multitable + +@end table + @node _gfortran_caf_send @subsection @code{_gfortran_caf_send} --- Sending data from a local image to a remote image @cindex Coarray, _gfortran_caf_send @table @asis @item @emph{Description}: -Called to send a scalar, an array section or whole array from a local +Called to send a scalar, an array section or a whole array from a local to a remote image identified by the image_index. @item @emph{Syntax}: @code{void _gfortran_caf_send (caf_token_t token, size_t offset, int image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector, -gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp)} +gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp, +int *stat)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{offset} @tab By which amount of bytes the actual data is shifted -compared to the base address of the coarray. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number. -@item @var{dest} @tab intent(in) Array descriptor for the remote image for the -bounds and the size. The base_addr shall not be accessed. -@item @var{dst_vector} @tab intent(int) If not NULL, it contains the vector +@item @var{offset} @tab intent(in) By which amount of bytes the actual data is +shifted compared to the base address of the coarray. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number. +@item @var{dest} @tab intent(in) Array descriptor for the remote image for the +bounds and the size. The @code{base_addr} shall not be accessed. +@item @var{dst_vector} @tab intent(in) If not NULL, it contains the vector subscript of the destination array; the values are relative to the dimension triplet of the dest argument. -@item @var{src} @tab intent(in) Array descriptor of the local array to be +@item @var{src} @tab intent(in) Array descriptor of the local array to be transferred to the remote image -@item @var{dst_kind} @tab Kind of the destination argument -@item @var{src_kind} @tab Kind of the source argument -@item @var{may_require_tmp} @tab The variable is false it is known at compile -time that the @var{dest} and @var{src} either cannot overlap or overlap (fully -or partially) such that walking @var{src} and @var{dest} in element wise -element order (honoring the stride value) will not lead to wrong results. -Otherwise, the value is true. +@item @var{dst_kind} @tab intent(in) Kind of the destination argument +@item @var{src_kind} @tab intent(in) Kind of the source argument +@item @var{may_require_tmp} @tab intent(in) The variable is @code{false} when +it is known at compile time that the @var{dest} and @var{src} either cannot +overlap or overlap (fully or partially) such that walking @var{src} and +@var{dest} in element wise element order (honoring the stride value) will not +lead to wrong results. Otherwise, the value is @code{true}. +@item @var{stat} @tab intent(out) when non-NULL give the result of the +operation, i.e., zero on success and non-zero on error. When NULL and an error +occurs, then an error message is printed and the program is terminated. @end multitable @item @emph{NOTES} -It is permitted to have image_id equal the current image; the memory of the -send-to and the send-from might (partially) overlap in that case. The +It is permitted to have @var{image_index} equal the current image; the memory +of the send-to and the send-from might (partially) overlap in that case. The implementation has to take care that it handles this case, e.g. using @code{memmove} which handles (partially) overlapping memory. If @var{may_require_tmp} is true, the library might additionally create a @@ -3835,40 +4479,44 @@ and different character kinds. @table @asis @item @emph{Description}: -Called to get an array section or whole array from a a remote, +Called to get an array section or a whole array from a remote, image identified by the image_index. @item @emph{Syntax}: -@code{void _gfortran_caf_get_desc (caf_token_t token, size_t offset, +@code{void _gfortran_caf_get (caf_token_t token, size_t offset, int image_index, gfc_descriptor_t *src, caf_vector_t *src_vector, -gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp)} +gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp, +int *stat)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{offset} @tab By which amount of bytes the actual data is shifted -compared to the base address of the coarray. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number. -@item @var{dest} @tab intent(in) Array descriptor of the local array to be -transferred to the remote image +@item @var{offset} @tab intent(in) By which amount of bytes the actual data is +shifted compared to the base address of the coarray. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number. +@item @var{dest} @tab intent(out) Array descriptor of the local array to store +the data retrieved from the remote image @item @var{src} @tab intent(in) Array descriptor for the remote image for the -bounds and the size. The base_addr shall not be accessed. -@item @var{src_vector} @tab intent(int) If not NULL, it contains the vector -subscript of the destination array; the values are relative to the dimension -triplet of the dest argument. -@item @var{dst_kind} @tab Kind of the destination argument -@item @var{src_kind} @tab Kind of the source argument -@item @var{may_require_tmp} @tab The variable is false it is known at compile -time that the @var{dest} and @var{src} either cannot overlap or overlap (fully -or partially) such that walking @var{src} and @var{dest} in element wise -element order (honoring the stride value) will not lead to wrong results. -Otherwise, the value is true. +bounds and the size. The @code{base_addr} shall not be accessed. +@item @var{src_vector} @tab intent(in) If not NULL, it contains the vector +subscript of the source array; the values are relative to the dimension +triplet of the @var{src} argument. +@item @var{dst_kind} @tab intent(in) Kind of the destination argument +@item @var{src_kind} @tab intent(in) Kind of the source argument +@item @var{may_require_tmp} @tab intent(in) The variable is @code{false} when +it is known at compile time that the @var{dest} and @var{src} either cannot +overlap or overlap (fully or partially) such that walking @var{src} and +@var{dest} in element wise element order (honoring the stride value) will not +lead to wrong results. Otherwise, the value is @code{true}. +@item @var{stat} @tab intent(out) When non-NULL give the result of the +operation, i.e., zero on success and non-zero on error. When NULL and an error +occurs, then an error message is printed and the program is terminated. @end multitable @item @emph{NOTES} -It is permitted to have image_id equal the current image; the memory of the -send-to and the send-from might (partially) overlap in that case. The +It is permitted to have @var{image_index} equal the current image; the memory of +the send-to and the send-from might (partially) overlap in that case. The implementation has to take care that it handles this case, e.g. using @code{memmove} which handles (partially) overlapping memory. If @var{may_require_tmp} is true, the library might additionally create a @@ -3887,53 +4535,59 @@ padding and different character kinds. @table @asis @item @emph{Description}: -Called to send a scalar, an array section or whole array from a remote image -identified by the src_image_index to a remote image identified by the -dst_image_index. +Called to send a scalar, an array section or a whole array from a remote image +identified by the @var{src_image_index} to a remote image identified by the +@var{dst_image_index}. @item @emph{Syntax}: @code{void _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset, int dst_image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector, caf_token_t src_token, size_t src_offset, int src_image_index, gfc_descriptor_t *src, caf_vector_t *src_vector, int dst_kind, int src_kind, -bool may_require_tmp)} +bool may_require_tmp, int *stat)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 @item @var{dst_token} @tab intent(in) An opaque pointer identifying the destination coarray. -@item @var{dst_offset} @tab By which amount of bytes the actual data is -shifted compared to the base address of the destination coarray. -@item @var{dst_image_index} @tab The ID of the destination remote image; must -be a positive number. +@item @var{dst_offset} @tab intent(in) By which amount of bytes the actual data +is shifted compared to the base address of the destination coarray. +@item @var{dst_image_index} @tab intent(in) The ID of the destination remote +image; must be a positive number. @item @var{dest} @tab intent(in) Array descriptor for the destination -remote image for the bounds and the size. The base_addr shall not be accessed. +remote image for the bounds and the size. The @code{base_addr} shall not be +accessed. @item @var{dst_vector} @tab intent(int) If not NULL, it contains the vector subscript of the destination array; the values are relative to the dimension -triplet of the dest argument. -@item @var{src_token} @tab An opaque pointer identifying the source coarray. -@item @var{src_offset} @tab By which amount of bytes the actual data is shifted -compared to the base address of the source coarray. -@item @var{src_image_index} @tab The ID of the source remote image; must be a -positive number. +triplet of the @var{dest} argument. +@item @var{src_token} @tab intent(in) An opaque pointer identifying the source +coarray. +@item @var{src_offset} @tab intent(in) By which amount of bytes the actual data +is shifted compared to the base address of the source coarray. +@item @var{src_image_index} @tab intent(in) The ID of the source remote image; +must be a positive number. @item @var{src} @tab intent(in) Array descriptor of the local array to be transferred to the remote image. @item @var{src_vector} @tab intent(in) Array descriptor of the local array to be transferred to the remote image -@item @var{dst_kind} @tab Kind of the destination argument -@item @var{src_kind} @tab Kind of the source argument -@item @var{may_require_tmp} @tab The variable is false it is known at compile -time that the @var{dest} and @var{src} either cannot overlap or overlap (fully -or partially) such that walking @var{src} and @var{dest} in element wise -element order (honoring the stride value) will not lead to wrong results. -Otherwise, the value is true. +@item @var{dst_kind} @tab intent(in) Kind of the destination argument +@item @var{src_kind} @tab intent(in) Kind of the source argument +@item @var{may_require_tmp} @tab intent(in) The variable is @code{false} when +it is known at compile time that the @var{dest} and @var{src} either cannot +overlap or overlap (fully or partially) such that walking @var{src} and +@var{dest} in element wise element order (honoring the stride value) will not +lead to wrong results. Otherwise, the value is @code{true}. +@item @var{stat} @tab intent(out) when non-NULL give the result of the +operation, i.e., zero on success and non-zero on error. When NULL and an error +occurs, then an error message is printed and the program is terminated. @end multitable @item @emph{NOTES} -It is permitted to have image_ids equal; the memory of the send-to and the -send-from might (partially) overlap in that case. The implementation has to -take care that it handles this case, e.g. using @code{memmove} which handles -(partially) overlapping memory. If @var{may_require_tmp} is true, the library +It is permitted to have the same image index for both @var{src_image_index} and +@var{dst_image_index}; the memory of the send-to and the send-from might +(partially) overlap in that case. The implementation has to take care that it +handles this case, e.g. using @code{memmove} which handles (partially) +overlapping memory. If @var{may_require_tmp} is true, the library might additionally create a temporary variable, unless additional checks show that this is not required (e.g. because walking backward is possible or because both arrays are contiguous and @code{memmove} takes care of overlap issues). @@ -3943,6 +4597,188 @@ the library has to handle numeric-type conversion and for strings, padding and different character kinds. @end table +@node _gfortran_caf_send_by_ref +@subsection @code{_gfortran_caf_send_by_ref} --- Sending data from a local image to a remote image with enhanced referencing options +@cindex Coarray, _gfortran_caf_send_by_ref + +@table @asis +@item @emph{Description}: +Called to send a scalar, an array section or a whole array from a local to a +remote image identified by the @var{image_index}. + +@item @emph{Syntax}: +@code{void _gfortran_caf_send_by_ref (caf_token_t token, int image_index, +gfc_descriptor_t *src, caf_reference_t *refs, int dst_kind, int src_kind, +bool may_require_tmp, bool dst_reallocatable, int *stat)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number. +@item @var{src} @tab intent(in) Array descriptor of the local array to be +transferred to the remote image +@item @var{refs} @tab intent(in) The references on the remote array to store +the data given by src. Guaranteed to have at least one entry. +@item @var{dst_kind} @tab intent(in) Kind of the destination argument +@item @var{src_kind} @tab intent(in) Kind of the source argument +@item @var{may_require_tmp} @tab intent(in) The variable is @code{false} when +it is known at compile time that the @var{dest} and @var{src} either cannot +overlap or overlap (fully or partially) such that walking @var{src} and +@var{dest} in element wise element order (honoring the stride value) will not +lead to wrong results. Otherwise, the value is @code{true}. +@item @var{dst_reallocatable} @tab intent(in) Set when the destination is of +allocatable or pointer type and the refs will allow reallocation, i.e., the ref +is a full array or component ref. +@item @var{stat} @tab intent(out) When non-@code{NULL} give the result of the +operation, i.e., zero on success and non-zero on error. When @code{NULL} and +an error occurs, then an error message is printed and the program is terminated. +@end multitable + +@item @emph{NOTES} +It is permitted to have @var{image_index} equal the current image; the memory of +the send-to and the send-from might (partially) overlap in that case. The +implementation has to take care that it handles this case, e.g. using +@code{memmove} which handles (partially) overlapping memory. If +@var{may_require_tmp} is true, the library might additionally create a +temporary variable, unless additional checks show that this is not required +(e.g. because walking backward is possible or because both arrays are +contiguous and @code{memmove} takes care of overlap issues). + +Note that the assignment of a scalar to an array is permitted. In addition, +the library has to handle numeric-type conversion and for strings, padding +and different character kinds. + +Because of the more complicated references possible some operations may be +unsupported by certain libraries. The library is expected to issue a precise +error message why the operation is not permitted. +@end table + + +@node _gfortran_caf_get_by_ref +@subsection @code{_gfortran_caf_get_by_ref} --- Getting data from a remote image using enhanced references +@cindex Coarray, _gfortran_caf_get_by_ref + +@table @asis +@item @emph{Description}: +Called to get a scalar, an array section or a whole array from a remote image +identified by the @var{image_index}. + +@item @emph{Syntax}: +@code{void _gfortran_caf_get_by_ref (caf_token_t token, int image_index, +caf_reference_t *refs, gfc_descriptor_t *dst, int dst_kind, int src_kind, +bool may_require_tmp, bool dst_reallocatable, int *stat)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number. +@item @var{refs} @tab intent(in) The references to apply to the remote structure +to get the data. +@item @var{dst} @tab intent(in) Array descriptor of the local array to store +the data transferred from the remote image. May be reallocated where needed +and when @var{DST_REALLOCATABLE} allows it. +@item @var{dst_kind} @tab intent(in) Kind of the destination argument +@item @var{src_kind} @tab intent(in) Kind of the source argument +@item @var{may_require_tmp} @tab intent(in) The variable is @code{false} when +it is known at compile time that the @var{dest} and @var{src} either cannot +overlap or overlap (fully or partially) such that walking @var{src} and +@var{dest} in element wise element order (honoring the stride value) will not +lead to wrong results. Otherwise, the value is @code{true}. +@item @var{dst_reallocatable} @tab intent(in) Set when @var{DST} is of +allocatable or pointer type and its refs allow reallocation, i.e., the full +array or a component is referenced. +@item @var{stat} @tab intent(out) When non-@code{NULL} give the result of the +operation, i.e., zero on success and non-zero on error. When @code{NULL} and an +error occurs, then an error message is printed and the program is terminated. +@end multitable + +@item @emph{NOTES} +It is permitted to have @code{image_index} equal the current image; the memory +of the send-to and the send-from might (partially) overlap in that case. The +implementation has to take care that it handles this case, e.g. using +@code{memmove} which handles (partially) overlapping memory. If +@var{may_require_tmp} is true, the library might additionally create a +temporary variable, unless additional checks show that this is not required +(e.g. because walking backward is possible or because both arrays are +contiguous and @code{memmove} takes care of overlap issues). + +Note that the library has to handle numeric-type conversion and for strings, +padding and different character kinds. + +Because of the more complicated references possible some operations may be +unsupported by certain libraries. The library is expected to issue a precise +error message why the operation is not permitted. +@end table + + +@node _gfortran_caf_sendget_by_ref +@subsection @code{_gfortran_caf_sendget_by_ref} --- Sending data between remote images using enhanced references on both sides +@cindex Coarray, _gfortran_caf_sendget_by_ref + +@table @asis +@item @emph{Description}: +Called to send a scalar, an array section or a whole array from a remote image +identified by the @var{src_image_index} to a remote image identified by the +@var{dst_image_index}. + +@item @emph{Syntax}: +@code{void _gfortran_caf_sendget_by_ref (caf_token_t dst_token, +int dst_image_index, caf_reference_t *dst_refs, +caf_token_t src_token, int src_image_index, caf_reference_t *src_refs, +int dst_kind, int src_kind, bool may_require_tmp, int *dst_stat, int *src_stat)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{dst_token} @tab intent(in) An opaque pointer identifying the +destination coarray. +@item @var{dst_image_index} @tab intent(in) The ID of the destination remote +image; must be a positive number. +@item @var{dst_refs} @tab intent(in) The references on the remote array to store +the data given by the source. Guaranteed to have at least one entry. +@item @var{src_token} @tab intent(in) An opaque pointer identifying the source +coarray. +@item @var{src_image_index} @tab intent(in) The ID of the source remote image; +must be a positive number. +@item @var{src_refs} @tab intent(in) The references to apply to the remote +structure to get the data. +@item @var{dst_kind} @tab intent(in) Kind of the destination argument +@item @var{src_kind} @tab intent(in) Kind of the source argument +@item @var{may_require_tmp} @tab intent(in) The variable is @code{false} when +it is known at compile time that the @var{dest} and @var{src} either cannot +overlap or overlap (fully or partially) such that walking @var{src} and +@var{dest} in element wise element order (honoring the stride value) will not +lead to wrong results. Otherwise, the value is @code{true}. +@item @var{dst_stat} @tab intent(out) when non-@code{NULL} give the result of +the send-operation, i.e., zero on success and non-zero on error. When +@code{NULL} and an error occurs, then an error message is printed and the +program is terminated. +@item @var{src_stat} @tab intent(out) When non-@code{NULL} give the result of +the get-operation, i.e., zero on success and non-zero on error. When +@code{NULL} and an error occurs, then an error message is printed and the +program is terminated. +@end multitable + +@item @emph{NOTES} +It is permitted to have the same image index for both @var{src_image_index} and +@var{dst_image_index}; the memory of the send-to and the send-from might +(partially) overlap in that case. The implementation has to take care that it +handles this case, e.g. using @code{memmove} which handles (partially) +overlapping memory. If @var{may_require_tmp} is true, the library +might additionally create a temporary variable, unless additional checks show +that this is not required (e.g. because walking backward is possible or because +both arrays are contiguous and @code{memmove} takes care of overlap issues). + +Note that the assignment of a scalar to an array is permitted. In addition, +the library has to handle numeric-type conversion and for strings, padding and +different character kinds. + +Because of the more complicated references possible some operations may be +unsupported by certain libraries. The library is expected to issue a precise +error message why the operation is not permitted. +@end table + @node _gfortran_caf_lock @subsection @code{_gfortran_caf_lock} --- Locking a lock variable @@ -3951,11 +4787,11 @@ different character kinds. @table @asis @item @emph{Description}: Acquire a lock on the given image on a scalar locking variable or for the -given array element for an array-valued variable. If the @var{aquired_lock} -is @code{NULL}, the function return after having obtained the lock. If it is -nonnull, the result is is assigned the value true (one) when the lock could be -obtained and false (zero) otherwise. Locking a lock variable which has already -been locked by the same image is an error. +given array element for an array-valued variable. If the @var{aquired_lock} +is @code{NULL}, the function returns after having obtained the lock. If it is +non-@code{NULL}, then @var{acquired_lock} is assigned the value true (one) when +the lock could be obtained and false (zero) otherwise. Locking a lock variable +which has already been locked by the same image is an error. @item @emph{Syntax}: @code{void _gfortran_caf_lock (caf_token_t token, size_t index, int image_index, @@ -3963,17 +4799,17 @@ int *aquired_lock, int *stat, char *errmsg, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{index} @tab Array index; first array index is 0. For scalars, it is -always 0. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number. +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{index} @tab intent(in) Array index; first array index is 0. For +scalars, it is always 0. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number. @item @var{aquired_lock} @tab intent(out) If not NULL, it returns whether lock -could be obtained -@item @var{stat} @tab intent(out) Stores the STAT=; may be NULL +could be obtained. +@item @var{stat} @tab intent(out) Stores the STAT=; may be NULL. @item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{errmsg_len} @tab the buffer size of errmsg. +an error message; may be NULL. +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @item @emph{NOTES} @@ -3998,16 +4834,16 @@ int *stat, char *errmsg, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{index} @tab Array index; first array index is 0. For scalars, it is -always 0. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number. +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{index} @tab intent(in) Array index; first array index is 0. For +scalars, it is always 0. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number. @item @var{stat} @tab intent(out) For allocatable coarrays, stores the STAT=; -may be NULL +may be NULL. @item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{errmsg_len} @tab the buffer size of errmsg. +an error message; may be NULL. +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @item @emph{NOTES} @@ -4030,22 +4866,22 @@ int image_index, int *stat, char *errmsg, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{index} @tab Array index; first array index is 0. For scalars, it is -always 0. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number; zero indicates the current image when accessed noncoindexed. -@item @var{stat} @tab intent(out) Stores the STAT=; may be NULL -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{index} @tab intent(in) Array index; first array index is 0. For +scalars, it is always 0. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number; zero indicates the current image, when accessed noncoindexed. +@item @var{stat} @tab intent(out) Stores the STAT=; may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @item @emph{NOTES} This acts like an atomic add of one to the remote image's event variable. The statement is an image-control statement but does not imply sync memory. Still, all preceeding push communications of this image to the specified -remote image has to be completed before @code{event_wait} on the remote +remote image have to be completed before @code{event_wait} on the remote image returns. @end table @@ -4067,15 +4903,15 @@ int until_count, int *stat, char *errmsg, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{index} @tab Array index; first array index is 0. For scalars, it is -always 0. -@item @var{until_count} @tab The number of events which have to be available -before the function returns. -@item @var{stat} @tab intent(out) Stores the STAT=; may be NULL -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{index} @tab intent(in) Array index; first array index is 0. For +scalars, it is always 0. +@item @var{until_count} @tab intent(in) The number of events which have to be +available before the function returns. +@item @var{stat} @tab intent(out) Stores the STAT=; may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @item @emph{NOTES} @@ -4085,12 +4921,13 @@ or equal the requested number of counts. Before the function returns, the event variable has to be decremented by the requested @var{until_count} value. A possible implementation would be a busy loop for a certain number of spins (possibly depending on the number of threads relative to the number of available -cores) followed by other waiting strategy such as a sleeping wait (possibly with -an increasing number of sleep time) or, if possible, a futex wait. +cores) followed by another waiting strategy such as a sleeping wait (possibly +with an increasing number of sleep time) or, if possible, a futex wait. The statement is an image-control statement but does not imply sync memory. -Still, all preceeding push communications to this image of images having -issued a @code{event_push} have to be completed before this function returns. +Still, all preceeding push communications of this image to the specified +remote image have to be completed before @code{event_wait} on the remote +image returns. @end table @@ -4101,7 +4938,7 @@ issued a @code{event_push} have to be completed before this function returns. @table @asis @item @emph{Description}: -Return the event count of the specified event count. +Return the event count of the specified event variable. @item @emph{Syntax}: @code{void _gfortran_caf_event_query (caf_token_t token, size_t index, @@ -4109,23 +4946,25 @@ int image_index, int *count, int *stat)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{index} @tab Array index; first array index is 0. For scalars, it is -always 0. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number; zero indicates the current image when accessed noncoindexed. -@item @var{count} @tab intent(out) The number of events currently posted to -the event variable -@item @var{stat} @tab intent(out) Stores the STAT=; may be NULL +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{index} @tab intent(in) Array index; first array index is 0. For +scalars, it is always 0. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number; zero indicates the current image when accessed noncoindexed. +@item @var{count} @tab intent(out) The number of events currently posted to +the event variable. +@item @var{stat} @tab intent(out) Stores the STAT=; may be NULL. @end multitable @item @emph{NOTES} -The typical use is to check the local even variable to only call +The typical use is to check the local event variable to only call @code{event_wait} when the data is available. However, a coindexed variable is permitted; there is no ordering or synchronization implied. It acts like an atomic fetch of the value of the event variable. @end table + + @node _gfortran_caf_sync_all @subsection @code{_gfortran_caf_sync_all} --- All-image barrier @cindex Coarray, _gfortran_caf_sync_all @@ -4142,10 +4981,10 @@ previous segment have completed. @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @end table @@ -4161,8 +5000,8 @@ Synchronization between the specified images; the program only continues on a given image after this function has been called on all images specified for that image. Note that one image can wait for all other images in the current team (e.g. via @code{sync images(*)}) while those only wait for that specific -image. Additionally, @code{sync images} it ensures that all pending data -transfers of previous segment have completed. +image. Additionally, @code{sync images} ensures that all pending data +transfers of previous segments have completed. @item @emph{Syntax}: @code{void _gfortran_caf_sync_images (int count, int images[], int *stat, @@ -4170,15 +5009,15 @@ char *errmsg, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{count} @tab the number of images which are provided in the next -argument. For a zero-sized array, the value is zero. For @code{sync -images (*)}, the value is @math{-1}. -@item @var{images} @tab intent(in) an array with the images provided by the -user. If @var{count} is zero, a NULL pointer is passed. -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{count} @tab intent(in) The number of images which are provided in +the next argument. For a zero-sized array, the value is zero. For +@code{sync images (*)}, the value is @math{-1}. +@item @var{images} @tab intent(in) An array with the images provided by the +user. If @var{count} is zero, a NULL pointer is passed. +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @end table @@ -4198,10 +5037,10 @@ all pending memory operations of this image have been completed. @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @item @emph{NOTE} A simple implementation could be @@ -4225,7 +5064,7 @@ function should terminate the program with the specified exit code. @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{error} @tab the exit status to be used. +@item @var{error} @tab intent(in) The exit status to be used. @end multitable @end table @@ -4245,13 +5084,31 @@ function should terminate the program with a nonzero-exit code. @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{string} @tab the error message (not zero terminated) -@item @var{len} @tab the length of the string +@item @var{string} @tab intent(in) the error message (not zero terminated) +@item @var{len} @tab intent(in) the length of the string @end multitable @end table +@node _gfortran_caf_fail_image +@subsection @code{_gfortran_caf_fail_image} --- Mark the image failed and end its execution +@cindex Coarray, _gfortran_caf_fail_image + +@table @asis +@item @emph{Description}: +Invoked for an @code{FAIL IMAGE} statement. The function should terminate the +current image. + +@item @emph{Syntax}: +@code{void _gfortran_caf_fail_image ()} + +@item @emph{NOTES} +This function follows TS18508. +@end table + + + @node _gfortran_caf_atomic_define @subsection @code{_gfortran_caf_atomic_define} --- Atomic variable assignment @cindex Coarray, _gfortran_caf_atomic_define @@ -4266,16 +5123,16 @@ int image_index, void *value, int *stat, int type, int kind)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{offset} @tab By which amount of bytes the actual data is shifted -compared to the base address of the coarray. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number; zero indicates the current image when used noncoindexed. -@item @var{value} @tab intent(in) the value to be assigned, passed by reference. -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{type} @tab the data type, i.e. @code{BT_INTEGER} (1) or +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{offset} @tab intent(in) By which amount of bytes the actual data is +shifted compared to the base address of the coarray. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number; zero indicates the current image when used noncoindexed. +@item @var{value} @tab intent(in) the value to be assigned, passed by reference +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{type} @tab intent(in) The data type, i.e. @code{BT_INTEGER} (1) or @code{BT_LOGICAL} (2). -@item @var{kind} @tab The kind value (only 4; always @code{int}) +@item @var{kind} @tab intent(in) The kind value (only 4; always @code{int}) @end multitable @end table @@ -4294,14 +5151,13 @@ Reference atomically a value of a kind-4 integer or logical variable. int image_index, void *value, int *stat, int type, int kind)} @item @emph{Arguments}: -@item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{offset} @tab By which amount of bytes the actual data is shifted -compared to the base address of the coarray. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number; zero indicates the current image when used noncoindexed. -@item @var{value} @tab intent(out) The variable assigned the atomically +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{offset} @tab intent(in) By which amount of bytes the actual data is +shifted compared to the base address of the coarray. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number; zero indicates the current image when used noncoindexed. +@item @var{value} @tab intent(out) The variable assigned the atomically referenced variable. @item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. @item @var{type} @tab the data type, i.e. @code{BT_INTEGER} (1) or @@ -4329,21 +5185,21 @@ int type, int kind)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{offset} @tab By which amount of bytes the actual data is shifted -compared to the base address of the coarray. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number; zero indicates the current image when used noncoindexed. -@item @var{old} @tab intent(out) the value which the atomic variable had +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{offset} @tab intent(in) By which amount of bytes the actual data is +shifted compared to the base address of the coarray. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number; zero indicates the current image when used noncoindexed. +@item @var{old} @tab intent(out) The value which the atomic variable had just before the cas operation. -@item @var{compare} @tab intent(in) The value used for comparision. -@item @var{new_val} @tab intent(in) The new value for the atomic variable, +@item @var{compare} @tab intent(in) The value used for comparision. +@item @var{new_val} @tab intent(in) The new value for the atomic variable, assigned to the atomic variable, if @code{compare} equals the value of the atomic variable. -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{type} @tab the data type, i.e. @code{BT_INTEGER} (1) or +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{type} @tab intent(in) the data type, i.e. @code{BT_INTEGER} (1) or @code{BT_LOGICAL} (2). -@item @var{kind} @tab The kind value (only 4; always @code{int}) +@item @var{kind} @tab intent(in) The kind value (only 4; always @code{int}) @end multitable @end table @@ -4358,7 +5214,7 @@ atomic variable. Apply an operation atomically to an atomic integer or logical variable. After the operation, @var{old} contains the value just before the operation, which, respectively, adds (GFC_CAF_ATOMIC_ADD) atomically the @code{value} to -the atomic integer variable or does a bitwise AND, OR or exclusive OR of the +the atomic integer variable or does a bitwise AND, OR or exclusive OR between the atomic variable and @var{value}; the result is then stored in the atomic variable. @@ -4368,23 +5224,23 @@ int image_index, void *value, void *old, int *stat, int type, int kind)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{op} @tab the operation to be performed; possible values +@item @var{op} @tab intent(in) the operation to be performed; possible values @code{GFC_CAF_ATOMIC_ADD} (1), @code{GFC_CAF_ATOMIC_AND} (2), @code{GFC_CAF_ATOMIC_OR} (3), @code{GFC_CAF_ATOMIC_XOR} (4). -@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. -@item @var{offset} @tab By which amount of bytes the actual data is shifted -compared to the base address of the coarray. -@item @var{image_index} @tab The ID of the remote image; must be a positive -number; zero indicates the current image when used noncoindexed. -@item @var{old} @tab intent(out) the value which the atomic variable had +@item @var{token} @tab intent(in) An opaque pointer identifying the coarray. +@item @var{offset} @tab intent(in) By which amount of bytes the actual data is +shifted compared to the base address of the coarray. +@item @var{image_index} @tab intent(in) The ID of the remote image; must be a +positive number; zero indicates the current image when used noncoindexed. +@item @var{old} @tab intent(out) The value which the atomic variable had just before the atomic operation. -@item @var{val} @tab intent(in) The new value for the atomic variable, +@item @var{val} @tab intent(in) The new value for the atomic variable, assigned to the atomic variable, if @code{compare} equals the value of the atomic variable. -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{type} @tab the data type, i.e. @code{BT_INTEGER} (1) or -@code{BT_LOGICAL} (2). -@item @var{kind} @tab The kind value (only 4; always @code{int}) +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{type} @tab intent(in) the data type, i.e. @code{BT_INTEGER} (1) or +@code{BT_LOGICAL} (2) +@item @var{kind} @tab intent(in) the kind value (only 4; always @code{int}) @end multitable @end table @@ -4406,14 +5262,14 @@ int source_image, int *stat, char *errmsg, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{a} @tab intent(inout) And array descriptor with the data to be -breoadcasted (on @var{source_image}) or to be received (other images). -@item @var{source_image} @tab The ID of the image from which the data should -be taken. -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{a} @tab intent(inout) An array descriptor with the data to be +broadcasted (on @var{source_image}) or to be received (other images). +@item @var{source_image} @tab intent(in) The ID of the image from which the +data should be broadcasted. +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg. @end multitable @end table @@ -4425,7 +5281,7 @@ an error message; may be NULL @table @asis @item @emph{Description}: -Calculates the for the each array element of the variable @var{a} the maximum +Calculates for each array element of the variable @var{a} the maximum value for that element in the current team; if @var{result_image} has the value 0, the result shall be stored on all images, otherwise, only on the specified image. This function operates on numeric values and character @@ -4437,20 +5293,21 @@ int *stat, char *errmsg, int a_len, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{a} @tab intent(inout) And array descriptor with the data to be -breoadcasted (on @var{source_image}) or to be received (other images). -@item @var{result_image} @tab The ID of the image to which the reduced -value should be copied to; if zero, it has to be copied to all images. -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{a_len} @tab The string length of argument @var{a}. -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{a} @tab intent(inout) An array descriptor for the data to be +processed. On the destination image(s) the result overwrites the old content. +@item @var{result_image} @tab intent(in) The ID of the image to which the +reduced value should be copied to; if zero, it has to be copied to all images. +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{a_len} @tab intent(in) the string length of argument @var{a} +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @item @emph{NOTES} -If @var{result_image} is nonzero, the value on all images except of the -specified one become undefined; hence, the library may make use of this. +If @var{result_image} is nonzero, the data in the array descriptor @var{a} on +all images except of the specified one become undefined; hence, the library may +make use of this. @end table @@ -4461,7 +5318,7 @@ specified one become undefined; hence, the library may make use of this. @table @asis @item @emph{Description}: -Calculates the for the each array element of the variable @var{a} the minimum +Calculates for each array element of the variable @var{a} the minimum value for that element in the current team; if @var{result_image} has the value 0, the result shall be stored on all images, otherwise, only on the specified image. This function operates on numeric values and character @@ -4473,20 +5330,21 @@ int *stat, char *errmsg, int a_len, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{a} @tab intent(inout) And array descriptor with the data to be -breoadcasted (on @var{source_image}) or to be received (other images). -@item @var{result_image} @tab The ID of the image to which the reduced -value should be copied to; if zero, it has to be copied to all images. -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{a_len} @tab The string length of argument @var{a}. -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{a} @tab intent(inout) An array descriptor for the data to be +processed. On the destination image(s) the result overwrites the old content. +@item @var{result_image} @tab intent(in) The ID of the image to which the +reduced value should be copied to; if zero, it has to be copied to all images. +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{a_len} @tab intent(in) the string length of argument @var{a} +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @item @emph{NOTES} -If @var{result_image} is nonzero, the value on all images except of the -specified one become undefined; hence, the library may make use of this. +If @var{result_image} is nonzero, the data in the array descriptor @var{a} on +all images except of the specified one become undefined; hence, the library may +make use of this. @end table @@ -4497,10 +5355,10 @@ specified one become undefined; hence, the library may make use of this. @table @asis @item @emph{Description}: -Calculates the for the each array element of the variable @var{a} the sum -value for that element in the current team; if @var{result_image} has the +Calculates for each array element of the variable @var{a} the sum of all +values for that element in the current team; if @var{result_image} has the value 0, the result shall be stored on all images, otherwise, only on the -specified image. This function operates on numeric values. +specified image. This function operates on numeric values only. @item @emph{Syntax}: @code{void _gfortran_caf_co_sum (gfc_descriptor_t *a, int result_image, @@ -4508,19 +5366,20 @@ int *stat, char *errmsg, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{a} @tab intent(inout) And array descriptor with the data to be -breoadcasted (on @var{source_image}) or to be received (other images). -@item @var{result_image} @tab The ID of the image to which the reduced -value should be copied to; if zero, it has to be copied to all images. -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{a} @tab intent(inout) An array descriptor with the data to be +processed. On the destination image(s) the result overwrites the old content. +@item @var{result_image} @tab intent(in) The ID of the image to which the +reduced value should be copied to; if zero, it has to be copied to all images. +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @item @emph{NOTES} -If @var{result_image} is nonzero, the value on all images except of the -specified one become undefined; hence, the library may make use of this. +If @var{result_image} is nonzero, the data in the array descriptor @var{a} on +all images except of the specified one become undefined; hence, the library may +make use of this. @end table @@ -4531,16 +5390,16 @@ specified one become undefined; hence, the library may make use of this. @table @asis @item @emph{Description}: -Calculates the for the each array element of the variable @var{a} the reduction +Calculates for each array element of the variable @var{a} the reduction value for that element in the current team; if @var{result_image} has the value 0, the result shall be stored on all images, otherwise, only on the -specified image. The @var{opr} is a pure function doing a mathematically +specified image. The @var{opr} is a pure function doing a mathematically commutative and associative operation. The @var{opr_flags} denote the following; the values are bitwise ored. @code{GFC_CAF_BYREF} (1) if the result should be returned -by value; @code{GFC_CAF_HIDDENLEN} (2) whether the result and argument -string lengths shall be specified as hidden argument; +by reference; @code{GFC_CAF_HIDDENLEN} (2) whether the result and argument +string lengths shall be specified as hidden arguments; @code{GFC_CAF_ARG_VALUE} (4) whether the arguments shall be passed by value, @code{GFC_CAF_ARG_DESC} (8) whether the arguments shall be passed by descriptor. @@ -4552,27 +5411,29 @@ int *stat, char *errmsg, int a_len, int errmsg_len)} @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{opr} @tab Function pointer to the reduction function. -@item @var{opr_flags} @tab Flags regarding the reduction function -@item @var{a} @tab intent(inout) And array descriptor with the data to be -breoadcasted (on @var{source_image}) or to be received (other images). -@item @var{result_image} @tab The ID of the image to which the reduced -value should be copied to; if zero, it has to be copied to all images. -@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. -@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to -an error message; may be NULL -@item @var{a_len} @tab The string length of argument @var{a}. -@item @var{errmsg_len} @tab the buffer size of errmsg. +@item @var{a} @tab intent(inout) An array descriptor with the data to be +processed. On the destination image(s) the result overwrites the old content. +@item @var{opr} @tab intent(in) Function pointer to the reduction function +@item @var{opr_flags} @tab intent(in) Flags regarding the reduction function +@item @var{result_image} @tab intent(in) The ID of the image to which the +reduced value should be copied to; if zero, it has to be copied to all images. +@item @var{stat} @tab intent(out) Stores the status STAT= and may be NULL. +@item @var{errmsg} @tab intent(out) When an error occurs, this will be set to +an error message; may be NULL. +@item @var{a_len} @tab intent(in) the string length of argument @var{a} +@item @var{errmsg_len} @tab intent(in) the buffer size of errmsg @end multitable @item @emph{NOTES} -If @var{result_image} is nonzero, the value on all images except of the -specified one become undefined; hence, the library may make use of this. +If @var{result_image} is nonzero, the data in the array descriptor @var{a} on +all images except of the specified one become undefined; hence, the library may +make use of this. + For character arguments, the result is passed as first argument, followed by the result string length, next come the two string arguments, followed -by the two hidden arguments. With C binding, there are no hidden arguments -and by-reference passing and either only a single character is passed or -an array descriptor. +by the two hidden string length arguments. With C binding, there are no hidden +arguments and by-reference passing and either only a single character is passed +or an array descriptor. @end table diff --git a/gcc/fortran/gfortranspec.c b/gcc/fortran/gfortranspec.c index 8a0e19a5c3..7a27f53da5 100644 --- a/gcc/fortran/gfortranspec.c +++ b/gcc/fortran/gfortranspec.c @@ -1,5 +1,5 @@ /* Specific flags and argument handling of the Fortran front-end. - Copyright (C) 1997-2016 Free Software Foundation, Inc. + Copyright (C) 1997-2017 Free Software Foundation, Inc. This file is part of GCC. @@ -276,7 +276,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 2016 Free Software Foundation, Inc.\n", + printf ("Copyright %s 2017 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"), diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 5bd1279291..6fe0647ecf 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1,5 +1,5 @@ /* Deal with interfaces. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -115,6 +115,21 @@ fold_unary_intrinsic (gfc_intrinsic_op op) } +/* Return the operator depending on the DTIO moded string. Note that + these are not operators in the normal sense and so have been placed + beyond GFC_INTRINSIC_END in gfortran.h:enum gfc_intrinsic_op. */ + +static gfc_intrinsic_op +dtio_op (char* mode) +{ + if (strncmp (mode, "formatted", 9) == 0) + return INTRINSIC_FORMATTED; + if (strncmp (mode, "unformatted", 9) == 0) + return INTRINSIC_UNFORMATTED; + return INTRINSIC_NONE; +} + + /* Match a generic specification. Depending on which type of interface is found, the 'name' or 'op' pointers may be set. This subroutine doesn't return MATCH_NO. */ @@ -162,6 +177,40 @@ gfc_match_generic_spec (interface_type *type, return MATCH_YES; } + if (gfc_match (" read ( %n )", buffer) == MATCH_YES) + { + *op = dtio_op (buffer); + if (*op == INTRINSIC_FORMATTED) + { + strcpy (name, gfc_code2string (dtio_procs, DTIO_RF)); + *type = INTERFACE_DTIO; + } + if (*op == INTRINSIC_UNFORMATTED) + { + strcpy (name, gfc_code2string (dtio_procs, DTIO_RUF)); + *type = INTERFACE_DTIO; + } + if (*op != INTRINSIC_NONE) + return MATCH_YES; + } + + if (gfc_match (" write ( %n )", buffer) == MATCH_YES) + { + *op = dtio_op (buffer); + if (*op == INTRINSIC_FORMATTED) + { + strcpy (name, gfc_code2string (dtio_procs, DTIO_WF)); + *type = INTERFACE_DTIO; + } + if (*op == INTRINSIC_UNFORMATTED) + { + strcpy (name, gfc_code2string (dtio_procs, DTIO_WUF)); + *type = INTERFACE_DTIO; + } + if (*op != INTRINSIC_NONE) + return MATCH_YES; + } + if (gfc_match_name (buffer) == MATCH_YES) { strcpy (name, buffer); @@ -209,6 +258,7 @@ gfc_match_interface (void) switch (type) { + case INTERFACE_DTIO: case INTERFACE_GENERIC: if (gfc_get_symbol (name, NULL, &sym)) return MATCH_ERROR; @@ -348,10 +398,10 @@ gfc_match_end_interface (void) m = MATCH_ERROR; if (strcmp(s2, "none") == 0) gfc_error ("Expecting %<END INTERFACE OPERATOR (%s)%> " - "at %C, ", s1); - else + "at %C", s1); + else gfc_error ("Expecting %<END INTERFACE OPERATOR (%s)%> at %C, " - "but got %s", s1, s2); + "but got %qs", s1, s2); } } @@ -371,6 +421,7 @@ gfc_match_end_interface (void) break; + case INTERFACE_DTIO: case INTERFACE_GENERIC: if (type != current_interface.type || strcmp (current_interface.sym->name, name) != 0) @@ -387,59 +438,90 @@ gfc_match_end_interface (void) } +/* Return whether the component was defined anonymously. */ + +static bool +is_anonymous_component (gfc_component *cmp) +{ + /* Only UNION and MAP components are anonymous. In the case of a MAP, + the derived type symbol is FL_STRUCT and the component name looks like mM*. + This is the only case in which the second character of a component name is + uppercase. */ + return cmp->ts.type == BT_UNION + || (cmp->ts.type == BT_DERIVED + && cmp->ts.u.derived->attr.flavor == FL_STRUCT + && cmp->name[0] && cmp->name[1] && ISUPPER (cmp->name[1])); +} + + +/* Return whether the derived type was defined anonymously. */ + +static bool +is_anonymous_dt (gfc_symbol *derived) +{ + /* UNION and MAP types are always anonymous. Otherwise, only nested STRUCTURE + types can be anonymous. For anonymous MAP/STRUCTURE, we have FL_STRUCT + and the type name looks like XX*. This is the only case in which the + second character of a type name is uppercase. */ + return derived->attr.flavor == FL_UNION + || (derived->attr.flavor == FL_STRUCT + && derived->name[0] && derived->name[1] && ISUPPER (derived->name[1])); +} + + /* Compare components according to 4.4.2 of the Fortran standard. */ -static int +static bool compare_components (gfc_component *cmp1, gfc_component *cmp2, gfc_symbol *derived1, gfc_symbol *derived2) { - gfc_symbol *d1, *d2; - bool anonymous = false; - - /* Unions, maps, and anonymous structures all have names like "[xX]X$\d+" - which should not be compared. */ - d1 = cmp1->ts.u.derived; - d2 = cmp2->ts.u.derived; - if ( (d1 && (d1->attr.flavor == FL_STRUCT || d1->attr.flavor == FL_UNION) - && ISUPPER (cmp1->name[1])) - || (d2 && (d2->attr.flavor == FL_STRUCT || d2->attr.flavor == FL_UNION) - && ISUPPER (cmp1->name[1]))) - anonymous = true; - - if (!anonymous && strcmp (cmp1->name, cmp2->name) != 0) - return 0; + /* Compare names, but not for anonymous components such as UNION or MAP. */ + if (!is_anonymous_component (cmp1) && !is_anonymous_component (cmp2) + && strcmp (cmp1->name, cmp2->name) != 0) + return false; if (cmp1->attr.access != cmp2->attr.access) - return 0; + return false; if (cmp1->attr.pointer != cmp2->attr.pointer) - return 0; + return false; if (cmp1->attr.dimension != cmp2->attr.dimension) - return 0; + return false; if (cmp1->attr.allocatable != cmp2->attr.allocatable) - return 0; + return false; if (cmp1->attr.dimension && gfc_compare_array_spec (cmp1->as, cmp2->as) == 0) - return 0; + return false; + + if (cmp1->ts.type == BT_CHARACTER && cmp2->ts.type == BT_CHARACTER) + { + gfc_charlen *l1 = cmp1->ts.u.cl; + gfc_charlen *l2 = cmp2->ts.u.cl; + if (l1 && l2 && l1->length && l2->length + && l1->length->expr_type == EXPR_CONSTANT + && l2->length->expr_type == EXPR_CONSTANT + && gfc_dep_compare_expr (l1->length, l2->length) != 0) + return false; + } /* Make sure that link lists do not put this function into an endless recursive loop! */ if (!(cmp1->ts.type == BT_DERIVED && derived1 == cmp1->ts.u.derived) && !(cmp2->ts.type == BT_DERIVED && derived2 == cmp2->ts.u.derived) - && gfc_compare_types (&cmp1->ts, &cmp2->ts) == 0) - return 0; + && !gfc_compare_types (&cmp1->ts, &cmp2->ts)) + return false; else if ( (cmp1->ts.type == BT_DERIVED && derived1 == cmp1->ts.u.derived) && !(cmp2->ts.type == BT_DERIVED && derived2 == cmp2->ts.u.derived)) - return 0; + return false; else if (!(cmp1->ts.type == BT_DERIVED && derived1 == cmp1->ts.u.derived) && (cmp2->ts.type == BT_DERIVED && derived2 == cmp2->ts.u.derived)) - return 0; + return false; - return 1; + return true; } @@ -451,13 +533,20 @@ compare_components (gfc_component *cmp1, gfc_component *cmp2, gfc_compare_derived_types, 'equal' is closer to meaning 'duplicate definitions' than 'equivalent structure'. */ -int -gfc_compare_union_types (gfc_symbol *un1, gfc_symbol *un2) +static bool +compare_union_types (gfc_symbol *un1, gfc_symbol *un2) { gfc_component *map1, *map2, *cmp1, *cmp2; + gfc_symbol *map1_t, *map2_t; if (un1->attr.flavor != FL_UNION || un2->attr.flavor != FL_UNION) - return 0; + return false; + + if (un1->attr.zero_comp != un2->attr.zero_comp) + return false; + + if (un1->attr.zero_comp) + return true; map1 = un1->components; map2 = un2->components; @@ -469,38 +558,48 @@ gfc_compare_union_types (gfc_symbol *un1, gfc_symbol *un2) we will say they are not equal for the purposes of this test; therefore we compare the maps sequentially. */ for (;;) - { - cmp1 = map1->ts.u.derived->components; - cmp2 = map2->ts.u.derived->components; - for (;;) - { - /* No two fields will ever point to the same map type unless they are - the same component, because one map field is created with its type - declaration. Therefore don't worry about recursion here. */ - /* TODO: worry about recursion into parent types of the unions? */ - if (compare_components (cmp1, cmp2, - map1->ts.u.derived, map2->ts.u.derived) == 0) - return 0; + { + map1_t = map1->ts.u.derived; + map2_t = map2->ts.u.derived; - cmp1 = cmp1->next; - cmp2 = cmp2->next; + cmp1 = map1_t->components; + cmp2 = map2_t->components; - if (cmp1 == NULL && cmp2 == NULL) - break; - if (cmp1 == NULL || cmp2 == NULL) - return 0; - } + /* Protect against null components. */ + if (map1_t->attr.zero_comp != map2_t->attr.zero_comp) + return false; - map1 = map1->next; - map2 = map2->next; + if (map1_t->attr.zero_comp) + return true; - if (map1 == NULL && map2 == NULL) - break; - if (map1 == NULL || map2 == NULL) - return 0; - } + for (;;) + { + /* No two fields will ever point to the same map type unless they are + the same component, because one map field is created with its type + declaration. Therefore don't worry about recursion here. */ + /* TODO: worry about recursion into parent types of the unions? */ + if (!compare_components (cmp1, cmp2, map1_t, map2_t)) + return false; - return 1; + cmp1 = cmp1->next; + cmp2 = cmp2->next; + + if (cmp1 == NULL && cmp2 == NULL) + break; + if (cmp1 == NULL || cmp2 == NULL) + return false; + } + + map1 = map1->next; + map2 = map2->next; + + if (map1 == NULL && map2 == NULL) + break; + if (map1 == NULL || map2 == NULL) + return false; + } + + return true; } @@ -508,25 +607,20 @@ gfc_compare_union_types (gfc_symbol *un1, gfc_symbol *un2) /* Compare two derived types using the criteria in 4.4.2 of the standard, recursing through gfc_compare_types for the components. */ -int +bool gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) { gfc_component *cmp1, *cmp2; - bool anonymous = false; if (derived1 == derived2) - return 1; + return true; - gcc_assert (derived1 && derived2); + if (!derived1 || !derived2) + gfc_internal_error ("gfc_compare_derived_types: invalid derived type"); - /* MAP and anonymous STRUCTURE types have internal names of the form - mM* and sS* (we can get away this this because source names are converted - to lowerase). Compare anonymous type names specially because each - gets a unique name when it is declared. */ - anonymous = (derived1->name[0] == derived2->name[0] - && derived1->name[1] && derived2->name[1] && derived2->name[2] - && derived1->name[1] == (char) TOUPPER (derived1->name[0]) - && derived2->name[2] == (char) TOUPPER (derived2->name[0])); + /* Compare UNION types specially. */ + if (derived1->attr.flavor == FL_UNION || derived2->attr.flavor == FL_UNION) + return compare_union_types (derived1, derived2); /* Special case for comparing derived types across namespaces. If the true names and module names are the same and the module name is @@ -534,30 +628,32 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) if (strcmp (derived1->name, derived2->name) == 0 && derived1->module != NULL && derived2->module != NULL && strcmp (derived1->module, derived2->module) == 0) - return 1; + return true; /* Compare type via the rules of the standard. Both types must have the SEQUENCE or BIND(C) attribute to be equal. STRUCTUREs are special because they can be anonymous; therefore two structures with different names may be equal. */ - if (strcmp (derived1->name, derived2->name) != 0 && !anonymous) - return 0; + /* Compare names, but not for anonymous types such as UNION or MAP. */ + if (!is_anonymous_dt (derived1) && !is_anonymous_dt (derived2) + && strcmp (derived1->name, derived2->name) != 0) + return false; if (derived1->component_access == ACCESS_PRIVATE || derived2->component_access == ACCESS_PRIVATE) - return 0; + return false; if (!(derived1->attr.sequence && derived2->attr.sequence) && !(derived1->attr.is_bind_c && derived2->attr.is_bind_c)) - return 0; + return false; /* Protect against null components. */ if (derived1->attr.zero_comp != derived2->attr.zero_comp) - return 0; + return false; if (derived1->attr.zero_comp) - return 1; + return true; cmp1 = derived1->components; cmp2 = derived2->components; @@ -568,7 +664,7 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) for (;;) { if (!compare_components (cmp1, cmp2, derived1, derived2)) - return 0; + return false; cmp1 = cmp1->next; cmp2 = cmp2->next; @@ -576,16 +672,16 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) if (cmp1 == NULL && cmp2 == NULL) break; if (cmp1 == NULL || cmp2 == NULL) - return 0; + return false; } - return 1; + return true; } /* Compare two typespecs, recursively if necessary. */ -int +bool gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) { /* See if one of the typespecs is a BT_VOID, which is what is being used @@ -593,7 +689,7 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) TODO: Possibly should narrow this to just the one typespec coming in that is for the formal arg, but oh well. */ if (ts1->type == BT_VOID || ts2->type == BT_VOID) - return 1; + return true; /* The _data component is not always present, therefore check for its presence before assuming, that its derived->attr is available. @@ -604,7 +700,7 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) && ts1->u.derived->components->ts.u.derived->attr .unlimited_polymorphic) || ts1->u.derived->attr.unlimited_polymorphic)) - return 1; + return true; /* F2003: C717 */ if (ts2->type == BT_CLASS && ts1->type == BT_DERIVED @@ -614,15 +710,16 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) .unlimited_polymorphic) || ts2->u.derived->attr.unlimited_polymorphic) && (ts1->u.derived->attr.sequence || ts1->u.derived->attr.is_bind_c)) - return 1; - - if (ts1->type == BT_UNION && ts2->type == BT_UNION) - return gfc_compare_union_types (ts1->u.derived, ts2->u.derived); + return true; if (ts1->type != ts2->type - && ((!gfc_bt_struct (ts1->type) && ts1->type != BT_CLASS) - || (!gfc_bt_struct (ts2->type) && ts2->type != BT_CLASS))) - return 0; + && ((ts1->type != BT_DERIVED && ts1->type != BT_CLASS) + || (ts2->type != BT_DERIVED && ts2->type != BT_CLASS))) + return false; + + if (ts1->type == BT_UNION) + return compare_union_types (ts1->u.derived, ts2->u.derived); + if (ts1->type != BT_DERIVED && ts1->type != BT_CLASS) return (ts1->kind == ts2->kind); @@ -631,30 +728,30 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) } -static int +static bool compare_type (gfc_symbol *s1, gfc_symbol *s2) { if (s2->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) - return 1; + return true; /* TYPE and CLASS of the same declared type are type compatible, but have different characteristics. */ if ((s1->ts.type == BT_CLASS && s2->ts.type == BT_DERIVED) || (s1->ts.type == BT_DERIVED && s2->ts.type == BT_CLASS)) - return 0; + return false; return gfc_compare_types (&s1->ts, &s2->ts) || s2->ts.type == BT_ASSUMED; } -static int +static bool compare_rank (gfc_symbol *s1, gfc_symbol *s2) { gfc_array_spec *as1, *as2; int r1, r2; if (s2->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) - return 1; + return true; as1 = (s1->ts.type == BT_CLASS) ? CLASS_DATA (s1)->as : s1->as; as2 = (s2->ts.type == BT_CLASS) ? CLASS_DATA (s2)->as : s2->as; @@ -663,17 +760,17 @@ compare_rank (gfc_symbol *s1, gfc_symbol *s2) r2 = as2 ? as2->rank : 0; if (r1 != r2 && (!as2 || as2->type != AS_ASSUMED_RANK)) - return 0; /* Ranks differ. */ + return false; /* Ranks differ. */ - return 1; + return true; } /* Given two symbols that are formal arguments, compare their ranks - and types. Returns nonzero if they have the same rank and type, - zero otherwise. */ + and types. Returns true if they have the same rank and type, + false otherwise. */ -static int +static bool compare_type_rank (gfc_symbol *s1, gfc_symbol *s2) { return compare_type (s1, s2) && compare_rank (s1, s2); @@ -682,44 +779,44 @@ compare_type_rank (gfc_symbol *s1, gfc_symbol *s2) /* Given two symbols that are formal arguments, compare their types and rank and their formal interfaces if they are both dummy - procedures. Returns nonzero if the same, zero if different. */ + procedures. Returns true if the same, false if different. */ -static int +static bool compare_type_rank_if (gfc_symbol *s1, gfc_symbol *s2) { if (s1 == NULL || s2 == NULL) - return s1 == s2 ? 1 : 0; + return (s1 == s2); if (s1 == s2) - return 1; + return true; if (s1->attr.flavor != FL_PROCEDURE && s2->attr.flavor != FL_PROCEDURE) return compare_type_rank (s1, s2); if (s1->attr.flavor != FL_PROCEDURE || s2->attr.flavor != FL_PROCEDURE) - return 0; + return false; /* At this point, both symbols are procedures. It can happen that external procedures are compared, where one is identified by usage to be a function or subroutine but the other is not. Check TKR nonetheless for these cases. */ if (s1->attr.function == 0 && s1->attr.subroutine == 0) - return s1->attr.external == 1 ? compare_type_rank (s1, s2) : 0; + return s1->attr.external ? compare_type_rank (s1, s2) : false; if (s2->attr.function == 0 && s2->attr.subroutine == 0) - return s2->attr.external == 1 ? compare_type_rank (s1, s2) : 0; + return s2->attr.external ? compare_type_rank (s1, s2) : false; /* Now the type of procedure has been identified. */ if (s1->attr.function != s2->attr.function || s1->attr.subroutine != s2->attr.subroutine) - return 0; + return false; - if (s1->attr.function && compare_type_rank (s1, s2) == 0) - return 0; + if (s1->attr.function && !compare_type_rank (s1, s2)) + return false; /* Originally, gfortran recursed here to check the interfaces of passed procedures. This is explicitly not required by the standard. */ - return 1; + return true; } @@ -992,11 +1089,11 @@ bad_repl: by this test. This subroutine implements rule 1 of section F03:16.2.3. 'p1' and 'p2' are the PASS arguments of both procedures (if applicable). */ -static int +static bool count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2, const char *p1, const char *p2) { - int rc, ac1, ac2, i, j, k, n1; + int ac1, ac2, i, j, k, n1; gfc_formal_arglist *f; typedef struct @@ -1051,7 +1148,7 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2, /* Now loop over each distinct type found in f1. */ k = 0; - rc = 0; + bool rc = false; for (i = 0; i < n1; i++) { @@ -1075,7 +1172,7 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2, if (ac1 > ac2) { - rc = 1; + rc = true; break; } @@ -1109,7 +1206,7 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2, At this point, 'CALL FOO(A=1, B=1.0)' is ambiguous. */ -static int +static bool generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, const char *p1, const char *p2) { @@ -1147,7 +1244,7 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, || ((gfc_option.allow_std & GFC_STD_F2008) && ((sym->attr.allocatable && g->sym->attr.pointer) || (sym->attr.pointer && g->sym->attr.allocatable)))) - return 1; + return true; } next: @@ -1157,7 +1254,7 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, f2 = f2->next; } - return 0; + return false; } @@ -1541,13 +1638,13 @@ gfc_check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, /* 'Compare' two formal interfaces associated with a pair of symbols. - We return nonzero if there exists an actual argument list that + We return true if there exists an actual argument list that would be ambiguous between the two interfaces, zero otherwise. 'strict_flag' specifies whether all the characteristics are required to match, which is not the case for ambiguity checks. 'p1' and 'p2' are the PASS arguments of both procedures (if applicable). */ -int +bool gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, int generic_flag, int strict_flag, char *errmsg, int err_len, @@ -1563,14 +1660,14 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, { if (errmsg != NULL) snprintf (errmsg, err_len, "'%s' is not a function", name2); - return 0; + return false; } if (s1->attr.subroutine && s2->attr.function) { if (errmsg != NULL) snprintf (errmsg, err_len, "'%s' is not a subroutine", name2); - return 0; + return false; } /* Do strict checks on all characteristics @@ -1582,39 +1679,48 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, /* If both are functions, check result characteristics. */ if (!gfc_check_result_characteristics (s1, s2, errmsg, err_len) || !gfc_check_result_characteristics (s2, s1, errmsg, err_len)) - return 0; + return false; } if (s1->attr.pure && !s2->attr.pure) { snprintf (errmsg, err_len, "Mismatch in PURE attribute"); - return 0; + return false; } if (s1->attr.elemental && !s2->attr.elemental) { snprintf (errmsg, err_len, "Mismatch in ELEMENTAL attribute"); - return 0; + return false; } } if (s1->attr.if_source == IFSRC_UNKNOWN || s2->attr.if_source == IFSRC_UNKNOWN) - return 1; + return true; f1 = gfc_sym_get_dummy_args (s1); f2 = gfc_sym_get_dummy_args (s2); + /* Special case: No arguments. */ if (f1 == NULL && f2 == NULL) - return 1; /* Special case: No arguments. */ + return true; if (generic_flag) { if (count_types_test (f1, f2, p1, p2) || count_types_test (f2, f1, p2, p1)) - return 0; + return false; + + /* Special case: alternate returns. If both f1->sym and f2->sym are + NULL, then the leading formal arguments are alternate returns. + The previous conditional should catch argument lists with + different number of argument. */ + if (f1 && f1->sym == NULL && f2 && f2->sym == NULL) + return true; + if (generic_correspondence (f1, f2, p1, p2) || generic_correspondence (f2, f1, p2, p1)) - return 0; + return false; } else /* Perform the abbreviated correspondence test for operators (the @@ -1622,28 +1728,23 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, This is also done when comparing interfaces for dummy procedures and in procedure pointer assignments. */ - for (;;) + for (; f1 || f2; f1 = f1->next, f2 = f2->next) { /* Check existence. */ - if (f1 == NULL && f2 == NULL) - break; if (f1 == NULL || f2 == NULL) { if (errmsg != NULL) snprintf (errmsg, err_len, "'%s' has the wrong number of " "arguments", name2); - return 0; + return false; } - if (UNLIMITED_POLY (f1->sym)) - goto next; - if (strict_flag) { /* Check all characteristics. */ if (!gfc_check_dummy_characteristics (f1->sym, f2->sym, true, errmsg, err_len)) - return 0; + return false; } else { @@ -1655,7 +1756,7 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, "(%s/%s)", f1->sym->name, gfc_typename (&f1->sym->ts), gfc_typename (&f2->sym->ts)); - return 0; + return false; } if (!compare_rank (f2->sym, f1->sym)) { @@ -1663,24 +1764,21 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, snprintf (errmsg, err_len, "Rank mismatch in argument '%s' " "(%i/%i)", f1->sym->name, symbol_rank (f1->sym), symbol_rank (f2->sym)); - return 0; + return false; } } -next: - f1 = f1->next; - f2 = f2->next; } - return 1; + return true; } /* Given a pointer to an interface pointer, remove duplicate interfaces and make sure that all symbols are either functions - or subroutines, and all of the same kind. Returns nonzero if + or subroutines, and all of the same kind. Returns true if something goes wrong. */ -static int +static bool check_interface0 (gfc_interface *p, const char *interface_name) { gfc_interface *psave, *q, *qlast; @@ -1701,7 +1799,7 @@ check_interface0 (gfc_interface *p, const char *interface_name) gfc_error ("Procedure %qs in %s at %L is neither function nor " "subroutine", p->sym->name, interface_name, &p->sym->declared_at); - return 1; + return true; } /* Verify that procedures are either all SUBROUTINEs or all FUNCTIONs. */ @@ -1717,7 +1815,7 @@ check_interface0 (gfc_interface *p, const char *interface_name) gfc_error ("In %s at %L procedures must be all FUNCTIONs as the " "generic name is also the name of a derived type", interface_name, &p->sym->declared_at); - return 1; + return true; } /* F2003, C1207. F2008, C1207. */ @@ -1725,7 +1823,7 @@ check_interface0 (gfc_interface *p, const char *interface_name) && !gfc_notify_std (GFC_STD_F2008, "Internal procedure " "%qs in %s at %L", p->sym->name, interface_name, &p->sym->declared_at)) - return 1; + return true; } p = psave; @@ -1751,14 +1849,14 @@ check_interface0 (gfc_interface *p, const char *interface_name) } } - return 0; + return false; } /* Check lists of interfaces to make sure that no two interfaces are ambiguous. Duplicate interfaces (from the same symbol) are OK here. */ -static int +static bool check_interface1 (gfc_interface *p, gfc_interface *q0, int generic_flag, const char *interface_name, bool referenced) @@ -1779,20 +1877,22 @@ check_interface1 (gfc_interface *p, gfc_interface *q0, generic_flag, 0, NULL, 0, NULL, NULL)) { if (referenced) - gfc_error ("Ambiguous interfaces %qs and %qs in %s at %L", - p->sym->name, q->sym->name, interface_name, - &p->where); + gfc_error ("Ambiguous interfaces in %s for %qs at %L " + "and %qs at %L", interface_name, + q->sym->name, &q->sym->declared_at, + p->sym->name, &p->sym->declared_at); else if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc) - gfc_warning (0, "Ambiguous interfaces %qs and %qs in %s at %L", - p->sym->name, q->sym->name, interface_name, - &p->where); + gfc_warning (0, "Ambiguous interfaces in %s for %qs at %L " + "and %qs at %L", interface_name, + q->sym->name, &q->sym->declared_at, + p->sym->name, &p->sym->declared_at); else gfc_warning (0, "Although not referenced, %qs has ambiguous " "interfaces at %L", interface_name, &p->where); - return 1; + return true; } } - return 0; + return false; } @@ -1970,22 +2070,22 @@ done: /* Given a symbol of a formal argument list and an expression, if the formal argument is allocatable, check that the actual argument is - allocatable. Returns nonzero if compatible, zero if not compatible. */ + allocatable. Returns true if compatible, zero if not compatible. */ -static int +static bool compare_allocatable (gfc_symbol *formal, gfc_expr *actual) { - symbol_attribute attr; - if (formal->attr.allocatable || (formal->ts.type == BT_CLASS && CLASS_DATA (formal)->attr.allocatable)) { - attr = gfc_expr_attr (actual); - if (!attr.allocatable) - return 0; + symbol_attribute attr = gfc_expr_attr (actual); + if (actual->ts.type == BT_CLASS && !attr.class_ok) + return true; + else if (!attr.allocatable) + return false; } - return 1; + return true; } @@ -2025,33 +2125,25 @@ argument_rank_mismatch (const char *name, locus *where, /* TS 29113, C407b. */ if (rank2 == -1) - { - gfc_error ("The assumed-rank array at %L requires that the dummy argument" - " %qs has assumed-rank", where, name); - } + gfc_error ("The assumed-rank array at %L requires that the dummy argument" + " %qs has assumed-rank", where, name); else if (rank1 == 0) - { - gfc_error ("Rank mismatch in argument %qs at %L " - "(scalar and rank-%d)", name, where, rank2); - } + gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs " + "at %L (scalar and rank-%d)", name, where, rank2); else if (rank2 == 0) - { - gfc_error ("Rank mismatch in argument %qs at %L " - "(rank-%d and scalar)", name, where, rank1); - } + gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs " + "at %L (rank-%d and scalar)", name, where, rank1); else - { - gfc_error ("Rank mismatch in argument %qs at %L " - "(rank-%d and rank-%d)", name, where, rank1, rank2); - } + gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs " + "at %L (rank-%d and rank-%d)", name, where, rank1, rank2); } /* Given a symbol of a formal argument list and an expression, see if - the two are compatible as arguments. Returns nonzero if - compatible, zero if not compatible. */ + the two are compatible as arguments. Returns true if + compatible, false if not compatible. */ -static int +static bool compare_parameter (gfc_symbol *formal, gfc_expr *actual, int ranks_must_agree, int is_elemental, locus *where) { @@ -2064,13 +2156,13 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, procs c_f_pointer or c_f_procpointer, and we need to accept most pointers the user could give us. This should allow that. */ if (formal->ts.type == BT_VOID) - return 1; + return true; if (formal->ts.type == BT_DERIVED && formal->ts.u.derived && formal->ts.u.derived->ts.is_iso_c && actual->ts.type == BT_DERIVED && actual->ts.u.derived && actual->ts.u.derived->ts.is_iso_c) - return 1; + return true; if (formal->ts.type == BT_CLASS && actual->ts.type == BT_DERIVED) /* Make sure the vtab symbol is present when @@ -2085,16 +2177,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, { if (where) gfc_error ("Invalid procedure argument at %L", &actual->where); - return 0; + return false; } if (!gfc_compare_interfaces (formal, act_sym, act_sym->name, 0, 1, err, sizeof(err), NULL, NULL)) { if (where) - gfc_error ("Interface mismatch in dummy procedure %qs at %L: %s", - formal->name, &actual->where, err); - return 0; + gfc_error_opt (OPT_Wargument_mismatch, + "Interface mismatch in dummy procedure %qs at %L:" + " %s", formal->name, &actual->where, err); + return false; } if (formal->attr.function && !act_sym->attr.function) @@ -2103,13 +2196,13 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, &act_sym->declared_at); if (act_sym->ts.type == BT_UNKNOWN && !gfc_set_default_type (act_sym, 1, act_sym->ns)) - return 0; + return false; } else if (formal->attr.subroutine && !act_sym->attr.subroutine) gfc_add_subroutine (&act_sym->attr, act_sym->name, &act_sym->declared_at); - return 1; + return true; } ppc = gfc_get_proc_ptr_comp (actual); @@ -2119,9 +2212,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, err, sizeof(err), NULL, NULL)) { if (where) - gfc_error ("Interface mismatch in dummy procedure %qs at %L: %s", - formal->name, &actual->where, err); - return 0; + gfc_error_opt (OPT_Wargument_mismatch, + "Interface mismatch in dummy procedure %qs at %L:" + " %s", formal->name, &actual->where, err); + return false; } } @@ -2132,9 +2226,13 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (where) gfc_error ("Actual argument to contiguous pointer dummy %qs at %L " "must be simply contiguous", formal->name, &actual->where); - return 0; + return false; } + symbol_attribute actual_attr = gfc_expr_attr (actual); + if (actual->ts.type == BT_CLASS && !actual_attr.class_ok) + return true; + if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN) && actual->ts.type != BT_HOLLERITH && formal->ts.type != BT_ASSUMED @@ -2145,10 +2243,11 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, CLASS_DATA (actual)->ts.u.derived))) { if (where) - gfc_error ("Type mismatch in argument %qs at %L; passed %s to %s", - formal->name, &actual->where, gfc_typename (&actual->ts), - gfc_typename (&formal->ts)); - return 0; + gfc_error_opt (OPT_Wargument_mismatch, + "Type mismatch in argument %qs at %L; passed %s to %s", + formal->name, where, gfc_typename (&actual->ts), + gfc_typename (&formal->ts)); + return false; } if (actual->ts.type == BT_ASSUMED && formal->ts.type != BT_ASSUMED) @@ -2157,7 +2256,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, gfc_error ("Assumed-type actual argument at %L requires that dummy " "argument %qs is of assumed type", &actual->where, formal->name); - return 0; + return false; } /* F2008, 12.5.2.5; IR F08/0073. */ @@ -2172,12 +2271,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (where) gfc_error ("Actual argument to %qs at %L must be polymorphic", formal->name, &actual->where); - return 0; + return false; } - if (!gfc_expr_attr (actual).class_ok) - return 0; - if ((!UNLIMITED_POLY (formal) || !UNLIMITED_POLY(actual)) && !gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived, CLASS_DATA (formal)->ts.u.derived)) @@ -2185,7 +2281,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (where) gfc_error ("Actual argument to %qs at %L must have the same " "declared type", formal->name, &actual->where); - return 0; + return false; } } @@ -2203,7 +2299,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, "pointer or allocatable unlimited polymorphic " "entity [F2008: 12.5.2.5]", formal->name, &actual->where); - return 0; + return false; } if (formal->attr.codimension && !gfc_is_coarray (actual)) @@ -2211,7 +2307,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (where) gfc_error ("Actual argument to %qs at %L must be a coarray", formal->name, &actual->where); - return 0; + return false; } if (formal->attr.codimension && formal->attr.allocatable) @@ -2232,7 +2328,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, formal->name, &actual->where, formal->as->corank, last ? last->u.c.component->as->corank : actual->symtree->n.sym->as->corank); - return 0; + return false; } } @@ -2242,14 +2338,14 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, /* F2015, 12.5.2.8. */ if (formal->attr.dimension && (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE) - && gfc_expr_attr (actual).dimension + && actual_attr.dimension && !gfc_is_simply_contiguous (actual, true, true)) { if (where) gfc_error ("Actual argument to %qs at %L must be simply " "contiguous or an element of such an array", formal->name, &actual->where); - return 0; + return false; } /* F2008, C1303 and C1304. */ @@ -2264,7 +2360,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, gfc_error ("Actual argument to non-INTENT(INOUT) dummy %qs at %L, " "which is LOCK_TYPE or has a LOCK_TYPE component", formal->name, &actual->where); - return 0; + return false; } /* TS18508, C702/C703. */ @@ -2279,7 +2375,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, gfc_error ("Actual argument to non-INTENT(INOUT) dummy %qs at %L, " "which is EVENT_TYPE or has a EVENT_TYPE component", formal->name, &actual->where); - return 0; + return false; } } @@ -2299,11 +2395,11 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, "assumed-rank array without CONTIGUOUS attribute - as actual" " argument at %L is not simply contiguous and both are " "ASYNCHRONOUS or VOLATILE", formal->name, &actual->where); - return 0; + return false; } if (formal->attr.allocatable && !formal->attr.codimension - && gfc_expr_attr (actual).codimension) + && actual_attr.codimension) { if (formal->attr.intent == INTENT_OUT) { @@ -2311,7 +2407,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, gfc_error ("Passing coarray at %L to allocatable, noncoarray, " "INTENT(OUT) dummy argument %qs", &actual->where, formal->name); - return 0; + return false; } else if (warn_surprising && where && formal->attr.intent != INTENT_IN) gfc_warning (OPT_Wsurprising, @@ -2322,7 +2418,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, /* If the rank is the same or the formal argument has assumed-rank. */ if (symbol_rank (formal) == actual->rank || symbol_rank (formal) == -1) - return 1; + return true; rank_check = where != NULL && !is_elemental && formal->as && (formal->as->type == AS_ASSUMED_SHAPE @@ -2331,7 +2427,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, /* Skip rank checks for NO_ARG_CHECK. */ if (formal->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) - return 1; + return true; /* Scalar & coindexed, see: F2008, Section 12.5.2.4. */ if (rank_check || ranks_must_agree @@ -2349,10 +2445,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (where) argument_rank_mismatch (formal->name, &actual->where, symbol_rank (formal), actual->rank); - return 0; + return false; } else if (actual->rank != 0 && (is_elemental || formal->attr.dimension)) - return 1; + return true; /* At this point, we are considering a scalar passed to an array. This is valid (cf. F95 12.4.1.1, F2003 12.4.1.2, and F2008 12.5.2.4), @@ -2380,7 +2476,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (where) gfc_error ("Polymorphic scalar passed to array dummy argument %qs " "at %L", formal->name, &actual->where); - return 0; + return false; } if (actual->expr_type != EXPR_NULL && ref && actual->ts.type != BT_CHARACTER @@ -2390,7 +2486,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, gfc_error ("Element of assumed-shaped or pointer " "array passed to array dummy argument %qs at %L", formal->name, &actual->where); - return 0; + return false; } if (actual->ts.type == BT_CHARACTER && actual->expr_type != EXPR_NULL @@ -2402,7 +2498,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, gfc_error ("Extension: Scalar non-default-kind, non-C_CHAR-kind " "CHARACTER actual argument with array dummy argument " "%qs at %L", formal->name, &actual->where); - return 0; + return false; } if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0) @@ -2410,12 +2506,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, gfc_error ("Fortran 2003: Scalar CHARACTER actual argument with " "array dummy argument %qs at %L", formal->name, &actual->where); - return 0; + return false; } - else if ((gfc_option.allow_std & GFC_STD_F2003) == 0) - return 0; else - return 1; + return ((gfc_option.allow_std & GFC_STD_F2003) != 0); } if (ref == NULL && actual->expr_type != EXPR_NULL) @@ -2423,10 +2517,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (where) argument_rank_mismatch (formal->name, &actual->where, symbol_rank (formal), actual->rank); - return 0; + return false; } - return 1; + return true; } @@ -2650,25 +2744,24 @@ get_expr_storage_size (gfc_expr *e) /* Given an expression, check whether it is an array section - which has a vector subscript. If it has, one is returned, - otherwise zero. */ + which has a vector subscript. */ -int +bool gfc_has_vector_subscript (gfc_expr *e) { int i; gfc_ref *ref; if (e == NULL || e->rank == 0 || e->expr_type != EXPR_VARIABLE) - return 0; + return false; for (ref = e->ref; ref; ref = ref->next) if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION) for (i = 0; i < ref->u.ar.dimen; i++) if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR) - return 1; + return true; - return 0; + return false; } @@ -2691,7 +2784,7 @@ is_procptr_result (gfc_expr *expr) errors when things don't match instead of just returning the status code. */ -static int +static bool compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, int ranks_must_agree, int is_elemental, locus *where) { @@ -2700,11 +2793,12 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, int i, n, na; unsigned long actual_size, formal_size; bool full_array = false; + gfc_array_ref *actual_arr_ref; actual = *ap; if (actual == NULL && formal == NULL) - return 1; + return true; n = 0; for (f = formal; f; f = f->next) @@ -2738,7 +2832,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Keyword argument %qs at %L is not in " "the procedure", a->name, &a->expr->where); - return 0; + return false; } if (new_arg[i] != NULL) @@ -2747,7 +2841,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, gfc_error ("Keyword argument %qs at %L is already associated " "with another actual argument", a->name, &a->expr->where); - return 0; + return false; } } @@ -2757,7 +2851,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, gfc_error ("More actual than formal arguments in procedure " "call at %L", where); - return 0; + return false; } if (f->sym == NULL && a->expr == NULL) @@ -2768,7 +2862,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Missing alternate return spec in subroutine call " "at %L", where); - return 0; + return false; } if (a->expr == NULL) @@ -2776,7 +2870,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Unexpected alternate return spec in subroutine " "call at %L", where); - return 0; + return false; } /* Make sure that intrinsic vtables exist for calls to unlimited @@ -2807,12 +2901,12 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, gfc_error ("Fortran 2008: Null pointer at %L to non-pointer " "dummy %qs", where, f->sym->name); - return 0; + return false; } if (!compare_parameter (f->sym, a->expr, ranks_must_agree, is_elemental, where)) - return 0; + return false; /* TS 29113, 6.3p2. */ if (f->sym->ts.type == BT_ASSUMED @@ -2839,44 +2933,45 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, and assumed-shape dummies, the string length needs to match exactly. */ if (a->expr->ts.type == BT_CHARACTER - && a->expr->ts.u.cl && a->expr->ts.u.cl->length - && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT - && f->sym->ts.u.cl && f->sym->ts.u.cl && f->sym->ts.u.cl->length - && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT - && (f->sym->attr.pointer || f->sym->attr.allocatable - || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE)) - && (mpz_cmp (a->expr->ts.u.cl->length->value.integer, - f->sym->ts.u.cl->length->value.integer) != 0)) - { - if (where && (f->sym->attr.pointer || f->sym->attr.allocatable)) - gfc_warning (0, - "Character length mismatch (%ld/%ld) between actual " - "argument and pointer or allocatable dummy argument " - "%qs at %L", - 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); - else if (where) - gfc_warning (0, - "Character length mismatch (%ld/%ld) between actual " - "argument and assumed-shape dummy argument %qs " - "at %L", - 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 0; - } + && a->expr->ts.u.cl && a->expr->ts.u.cl->length + && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT + && f->sym->ts.type == BT_CHARACTER && f->sym->ts.u.cl + && f->sym->ts.u.cl->length + && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT + && (f->sym->attr.pointer || f->sym->attr.allocatable + || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE)) + && (mpz_cmp (a->expr->ts.u.cl->length->value.integer, + f->sym->ts.u.cl->length->value.integer) != 0)) + { + if (where && (f->sym->attr.pointer || f->sym->attr.allocatable)) + gfc_warning (OPT_Wargument_mismatch, + "Character length mismatch (%ld/%ld) between actual " + "argument and pointer or allocatable dummy argument " + "%qs at %L", + 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); + else if (where) + gfc_warning (OPT_Wargument_mismatch, + "Character length mismatch (%ld/%ld) between actual " + "argument and assumed-shape dummy argument %qs " + "at %L", + 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; + } if ((f->sym->attr.pointer || f->sym->attr.allocatable) - && f->sym->ts.deferred != a->expr->ts.deferred - && a->expr->ts.type == BT_CHARACTER) + && f->sym->ts.deferred != a->expr->ts.deferred + && a->expr->ts.type == BT_CHARACTER) { if (where) gfc_error ("Actual argument at %L to allocatable or " "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 0; + return false; } if (f->sym->ts.type == BT_CLASS) @@ -2889,16 +2984,18 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, && f->sym->attr.flavor != FL_PROCEDURE) { if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where) - gfc_warning (0, "Character length of actual argument shorter " + gfc_warning (OPT_Wargument_mismatch, + "Character length of actual argument shorter " "than of dummy argument %qs (%lu/%lu) at %L", f->sym->name, actual_size, formal_size, &a->expr->where); else if (where) - gfc_warning (0, "Actual argument contains too few " + gfc_warning (OPT_Wargument_mismatch, + "Actual argument contains too few " "elements for dummy argument %qs (%lu/%lu) at %L", f->sym->name, actual_size, formal_size, &a->expr->where); - return 0; + return false; } skip_size_check: @@ -2915,7 +3012,7 @@ 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 0; + return false; } /* Satisfy F03:12.4.1.3 by ensuring that a procedure actual argument is @@ -2931,7 +3028,7 @@ 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 0; + return false; } if (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE @@ -2945,7 +3042,7 @@ 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 0; + return false; } if (a->expr->expr_type != EXPR_NULL @@ -2954,7 +3051,7 @@ 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 0; + return false; } if (a->expr->expr_type != EXPR_NULL @@ -2964,7 +3061,7 @@ 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 0; + return false; } @@ -2975,7 +3072,7 @@ 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 0; + return false; } /* Fortran 2008, 12.5.2.5 (no constraint). */ @@ -2988,7 +3085,7 @@ 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 0; + return false; } /* Fortran 2008, C1237. */ @@ -3003,7 +3100,7 @@ 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 0; + return false; } /* Fortran 2008, 12.5.2.4 (no constraint). */ @@ -3016,7 +3113,7 @@ 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 0; + return false; } if (f->sym->ts.type == BT_CLASS @@ -3027,17 +3124,17 @@ 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 0; + return false; } if (a->expr->expr_type != EXPR_NULL - && compare_allocatable (f->sym, a->expr) == 0) + && !compare_allocatable (f->sym, a->expr)) { if (where) gfc_error ("Actual argument for %qs must be ALLOCATABLE at %L", f->sym->name, &a->expr->where); - return 0; + return false; } /* Check intent = OUT/INOUT for definable actual argument. */ @@ -3052,9 +3149,9 @@ 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 0; + return false; if (!gfc_check_vardef_context (a->expr, false, false, false, context)) - return 0; + return false; } if ((f->sym->attr.intent == INTENT_OUT @@ -3069,7 +3166,7 @@ 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 0; + return false; } /* C1232 (R1221) For an actual argument which is an array section or @@ -3077,6 +3174,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, shape array, if the dummy argument has the VOLATILE attribute. */ if (f->sym->attr.volatile_ + && a->expr->expr_type == EXPR_VARIABLE && a->expr->symtree->n.sym->as && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SHAPE && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE)) @@ -3086,19 +3184,24 @@ 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 0; + return false; } + /* Find the last array_ref. */ + actual_arr_ref = NULL; + if (a->expr->ref) + actual_arr_ref = gfc_find_array_ref (a->expr, true); + if (f->sym->attr.volatile_ - && a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION + && actual_arr_ref && actual_arr_ref->type == AR_SECTION && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE)) { if (where) gfc_error ("Array-section actual argument at %L is " "incompatible with the non-assumed-shape " "dummy argument %qs due to VOLATILE attribute", - &a->expr->where,f->sym->name); - return 0; + &a->expr->where, f->sym->name); + return false; } /* C1233 (R1221) For an actual argument which is a pointer array, the @@ -3106,6 +3209,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, dummy argument has the VOLATILE attribute. */ if (f->sym->attr.volatile_ + && a->expr->expr_type == EXPR_VARIABLE && a->expr->symtree->n.sym->attr.pointer && a->expr->symtree->n.sym->as && !(f->sym->as @@ -3117,7 +3221,7 @@ 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 0; + return false; } match: @@ -3138,14 +3242,14 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Missing alternate return spec in subroutine call " "at %L", where); - return 0; + return false; } if (!f->sym->attr.optional) { if (where) gfc_error ("Missing actual argument for argument %qs at %L", f->sym->name, where); - return 0; + return false; } } @@ -3175,7 +3279,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (a->expr == NULL && a->label == NULL) a->missing_arg_type = f->sym->ts.type; - return 1; + return true; } @@ -3770,7 +3874,7 @@ matching_typebound_op (gfc_expr** tb_base, if (base->expr->ts.type == BT_CLASS) { - if (CLASS_DATA (base->expr) == NULL + if (!base->expr->ts.u.derived || CLASS_DATA (base->expr) == NULL || !gfc_expr_attr (base->expr).class_ok) continue; derived = CLASS_DATA (base->expr)->ts.u.derived; @@ -3945,7 +4049,7 @@ gfc_extend_expr (gfc_expr *e) else return MATCH_YES; } - + if (i == INTRINSIC_USER) { for (ns = gfc_current_ns; ns; ns = ns->parent) @@ -4136,60 +4240,60 @@ gfc_add_interface (gfc_symbol *new_sym) { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: - if (!gfc_check_new_interface (ns->op[INTRINSIC_EQ], new_sym, + if (!gfc_check_new_interface (ns->op[INTRINSIC_EQ], new_sym, gfc_current_locus) - || !gfc_check_new_interface (ns->op[INTRINSIC_EQ_OS], + || !gfc_check_new_interface (ns->op[INTRINSIC_EQ_OS], new_sym, gfc_current_locus)) return false; break; case INTRINSIC_NE: case INTRINSIC_NE_OS: - if (!gfc_check_new_interface (ns->op[INTRINSIC_NE], new_sym, + if (!gfc_check_new_interface (ns->op[INTRINSIC_NE], new_sym, gfc_current_locus) - || !gfc_check_new_interface (ns->op[INTRINSIC_NE_OS], + || !gfc_check_new_interface (ns->op[INTRINSIC_NE_OS], new_sym, gfc_current_locus)) return false; break; case INTRINSIC_GT: case INTRINSIC_GT_OS: - if (!gfc_check_new_interface (ns->op[INTRINSIC_GT], + if (!gfc_check_new_interface (ns->op[INTRINSIC_GT], new_sym, gfc_current_locus) - || !gfc_check_new_interface (ns->op[INTRINSIC_GT_OS], + || !gfc_check_new_interface (ns->op[INTRINSIC_GT_OS], new_sym, gfc_current_locus)) return false; break; case INTRINSIC_GE: case INTRINSIC_GE_OS: - if (!gfc_check_new_interface (ns->op[INTRINSIC_GE], + if (!gfc_check_new_interface (ns->op[INTRINSIC_GE], new_sym, gfc_current_locus) - || !gfc_check_new_interface (ns->op[INTRINSIC_GE_OS], + || !gfc_check_new_interface (ns->op[INTRINSIC_GE_OS], new_sym, gfc_current_locus)) return false; break; case INTRINSIC_LT: case INTRINSIC_LT_OS: - if (!gfc_check_new_interface (ns->op[INTRINSIC_LT], + if (!gfc_check_new_interface (ns->op[INTRINSIC_LT], new_sym, gfc_current_locus) - || !gfc_check_new_interface (ns->op[INTRINSIC_LT_OS], + || !gfc_check_new_interface (ns->op[INTRINSIC_LT_OS], new_sym, gfc_current_locus)) return false; break; case INTRINSIC_LE: case INTRINSIC_LE_OS: - if (!gfc_check_new_interface (ns->op[INTRINSIC_LE], + if (!gfc_check_new_interface (ns->op[INTRINSIC_LE], new_sym, gfc_current_locus) - || !gfc_check_new_interface (ns->op[INTRINSIC_LE_OS], + || !gfc_check_new_interface (ns->op[INTRINSIC_LE_OS], new_sym, gfc_current_locus)) return false; break; default: - if (!gfc_check_new_interface (ns->op[current_interface.op], + if (!gfc_check_new_interface (ns->op[current_interface.op], new_sym, gfc_current_locus)) return false; } @@ -4198,13 +4302,14 @@ gfc_add_interface (gfc_symbol *new_sym) break; case INTERFACE_GENERIC: + case INTERFACE_DTIO: for (ns = current_interface.ns; ns; ns = ns->parent) { gfc_find_symbol (current_interface.sym->name, ns, 0, &sym); if (sym == NULL) continue; - if (!gfc_check_new_interface (sym->generic, + if (!gfc_check_new_interface (sym->generic, new_sym, gfc_current_locus)) return false; } @@ -4213,7 +4318,7 @@ gfc_add_interface (gfc_symbol *new_sym) break; case INTERFACE_USER_OP: - if (!gfc_check_new_interface (current_interface.uop->op, + if (!gfc_check_new_interface (current_interface.uop->op, new_sym, gfc_current_locus)) return false; @@ -4242,15 +4347,13 @@ gfc_current_interface_head (void) { case INTERFACE_INTRINSIC_OP: return current_interface.ns->op[current_interface.op]; - break; case INTERFACE_GENERIC: + case INTERFACE_DTIO: return current_interface.sym->generic; - break; case INTERFACE_USER_OP: return current_interface.uop->op; - break; default: gcc_unreachable (); @@ -4268,6 +4371,7 @@ gfc_set_current_interface_head (gfc_interface *i) break; case INTERFACE_GENERIC: + case INTERFACE_DTIO: current_interface.sym->generic = i; break; @@ -4439,8 +4543,9 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) if (!gfc_check_dummy_characteristics (proc_formal->sym, old_formal->sym, check_type, err, sizeof(err))) { - gfc_error ("Argument mismatch for the overriding procedure " - "%qs at %L: %s", proc->name, &where, err); + gfc_error_opt (OPT_Wargument_mismatch, + "Argument mismatch for the overriding procedure " + "%qs at %L: %s", proc->name, &where, err); return false; } @@ -4484,3 +4589,379 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) return true; } + + +/* The following three functions check that the formal arguments + of user defined derived type IO procedures are compliant with + the requirements of the standard. */ + +static void +check_dtio_arg_TKR_intent (gfc_symbol *fsym, bool typebound, bt type, + int kind, int rank, sym_intent intent) +{ + if (fsym->ts.type != type) + { + gfc_error ("DTIO dummy argument at %L must be of type %s", + &fsym->declared_at, gfc_basic_typename (type)); + return; + } + + if (fsym->ts.type != BT_CLASS && fsym->ts.type != BT_DERIVED + && fsym->ts.kind != kind) + gfc_error ("DTIO dummy argument at %L must be of KIND = %d", + &fsym->declared_at, kind); + + if (!typebound + && rank == 0 + && (((type == BT_CLASS) && CLASS_DATA (fsym)->attr.dimension) + || ((type != BT_CLASS) && fsym->attr.dimension))) + gfc_error ("DTIO dummy argument at %L must be a scalar", + &fsym->declared_at); + else if (rank == 1 + && (fsym->as == NULL || fsym->as->type != AS_ASSUMED_SHAPE)) + gfc_error ("DTIO dummy argument at %L must be an " + "ASSUMED SHAPE ARRAY", &fsym->declared_at); + + if (fsym->attr.intent != intent) + gfc_error ("DTIO dummy argument at %L must have INTENT %s", + &fsym->declared_at, gfc_code2string (intents, (int)intent)); + return; +} + + +static void +check_dtio_interface1 (gfc_symbol *derived, gfc_symtree *tb_io_st, + bool typebound, bool formatted, int code) +{ + gfc_symbol *dtio_sub, *generic_proc, *fsym; + gfc_typebound_proc *tb_io_proc, *specific_proc; + gfc_interface *intr; + gfc_formal_arglist *formal; + int arg_num; + + bool read = ((dtio_codes)code == DTIO_RF) + || ((dtio_codes)code == DTIO_RUF); + bt type; + sym_intent intent; + int kind; + + dtio_sub = NULL; + if (typebound) + { + /* Typebound DTIO binding. */ + tb_io_proc = tb_io_st->n.tb; + if (tb_io_proc == NULL) + return; + + gcc_assert (tb_io_proc->is_generic); + gcc_assert (tb_io_proc->u.generic->next == NULL); + + specific_proc = tb_io_proc->u.generic->specific; + if (specific_proc == NULL || specific_proc->is_generic) + return; + + dtio_sub = specific_proc->u.specific->n.sym; + } + else + { + generic_proc = tb_io_st->n.sym; + if (generic_proc == NULL || generic_proc->generic == NULL) + return; + + for (intr = tb_io_st->n.sym->generic; intr; intr = intr->next) + { + if (intr->sym && intr->sym->formal && intr->sym->formal->sym + && ((intr->sym->formal->sym->ts.type == BT_CLASS + && CLASS_DATA (intr->sym->formal->sym)->ts.u.derived + == derived) + || (intr->sym->formal->sym->ts.type == BT_DERIVED + && intr->sym->formal->sym->ts.u.derived == derived))) + { + dtio_sub = intr->sym; + break; + } + else if (intr->sym && intr->sym->formal && !intr->sym->formal->sym) + { + gfc_error ("Alternate return at %L is not permitted in a DTIO " + "procedure", &intr->sym->declared_at); + return; + } + } + + if (dtio_sub == NULL) + return; + } + + gcc_assert (dtio_sub); + if (!dtio_sub->attr.subroutine) + gfc_error ("DTIO procedure %qs at %L must be a subroutine", + dtio_sub->name, &dtio_sub->declared_at); + + arg_num = 0; + for (formal = dtio_sub->formal; formal; formal = formal->next) + arg_num++; + + if (arg_num < (formatted ? 6 : 4)) + { + gfc_error ("Too few dummy arguments in DTIO procedure %qs at %L", + dtio_sub->name, &dtio_sub->declared_at); + return; + } + + if (arg_num > (formatted ? 6 : 4)) + { + gfc_error ("Too many dummy arguments in DTIO procedure %qs at %L", + dtio_sub->name, &dtio_sub->declared_at); + return; + } + + + /* Now go through the formal arglist. */ + arg_num = 1; + for (formal = dtio_sub->formal; formal; formal = formal->next, arg_num++) + { + if (!formatted && arg_num == 3) + arg_num = 5; + fsym = formal->sym; + + if (fsym == NULL) + { + gfc_error ("Alternate return at %L is not permitted in a DTIO " + "procedure", &dtio_sub->declared_at); + return; + } + + switch (arg_num) + { + case(1): /* DTV */ + type = derived->attr.sequence || derived->attr.is_bind_c ? + BT_DERIVED : BT_CLASS; + kind = 0; + intent = read ? INTENT_INOUT : INTENT_IN; + check_dtio_arg_TKR_intent (fsym, typebound, type, kind, + 0, intent); + break; + + case(2): /* UNIT */ + type = BT_INTEGER; + kind = gfc_default_integer_kind; + intent = INTENT_IN; + check_dtio_arg_TKR_intent (fsym, typebound, type, kind, + 0, intent); + break; + case(3): /* IOTYPE */ + type = BT_CHARACTER; + kind = gfc_default_character_kind; + intent = INTENT_IN; + check_dtio_arg_TKR_intent (fsym, typebound, type, kind, + 0, intent); + break; + case(4): /* VLIST */ + type = BT_INTEGER; + kind = gfc_default_integer_kind; + intent = INTENT_IN; + check_dtio_arg_TKR_intent (fsym, typebound, type, kind, + 1, intent); + break; + case(5): /* IOSTAT */ + type = BT_INTEGER; + kind = gfc_default_integer_kind; + intent = INTENT_OUT; + check_dtio_arg_TKR_intent (fsym, typebound, type, kind, + 0, intent); + break; + case(6): /* IOMSG */ + type = BT_CHARACTER; + kind = gfc_default_character_kind; + intent = INTENT_INOUT; + check_dtio_arg_TKR_intent (fsym, typebound, type, kind, + 0, intent); + break; + default: + gcc_unreachable (); + } + } + derived->attr.has_dtio_procs = 1; + return; +} + +void +gfc_check_dtio_interfaces (gfc_symbol *derived) +{ + gfc_symtree *tb_io_st; + bool t = false; + int code; + bool formatted; + + if (derived->attr.is_class == 1 || derived->attr.vtype == 1) + return; + + /* Check typebound DTIO bindings. */ + for (code = 0; code < 4; code++) + { + formatted = ((dtio_codes)code == DTIO_RF) + || ((dtio_codes)code == DTIO_WF); + + tb_io_st = gfc_find_typebound_proc (derived, &t, + gfc_code2string (dtio_procs, code), + true, &derived->declared_at); + if (tb_io_st != NULL) + check_dtio_interface1 (derived, tb_io_st, true, formatted, code); + } + + /* Check generic DTIO interfaces. */ + for (code = 0; code < 4; code++) + { + formatted = ((dtio_codes)code == DTIO_RF) + || ((dtio_codes)code == DTIO_WF); + + tb_io_st = gfc_find_symtree (derived->ns->sym_root, + gfc_code2string (dtio_procs, code)); + if (tb_io_st != NULL) + check_dtio_interface1 (derived, tb_io_st, false, formatted, code); + } +} + + +gfc_symtree* +gfc_find_typebound_dtio_proc (gfc_symbol *derived, bool write, bool formatted) +{ + gfc_symtree *tb_io_st = NULL; + bool t = false; + + if (!derived || !derived->resolved || derived->attr.flavor != FL_DERIVED) + return NULL; + + /* Try to find a typebound DTIO binding. */ + if (formatted == true) + { + if (write == true) + tb_io_st = gfc_find_typebound_proc (derived, &t, + gfc_code2string (dtio_procs, + DTIO_WF), + true, + &derived->declared_at); + else + tb_io_st = gfc_find_typebound_proc (derived, &t, + gfc_code2string (dtio_procs, + DTIO_RF), + true, + &derived->declared_at); + } + else + { + if (write == true) + tb_io_st = gfc_find_typebound_proc (derived, &t, + gfc_code2string (dtio_procs, + DTIO_WUF), + true, + &derived->declared_at); + else + tb_io_st = gfc_find_typebound_proc (derived, &t, + gfc_code2string (dtio_procs, + DTIO_RUF), + true, + &derived->declared_at); + } + return tb_io_st; +} + + +gfc_symbol * +gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted) +{ + gfc_symtree *tb_io_st = NULL; + gfc_symbol *dtio_sub = NULL; + gfc_symbol *extended; + gfc_typebound_proc *tb_io_proc, *specific_proc; + + tb_io_st = gfc_find_typebound_dtio_proc (derived, write, formatted); + + if (tb_io_st != NULL) + { + const char *genname; + gfc_symtree *st; + + tb_io_proc = tb_io_st->n.tb; + gcc_assert (tb_io_proc != NULL); + gcc_assert (tb_io_proc->is_generic); + gcc_assert (tb_io_proc->u.generic->next == NULL); + + specific_proc = tb_io_proc->u.generic->specific; + gcc_assert (!specific_proc->is_generic); + + /* Go back and make sure that we have the right specific procedure. + Here we most likely have a procedure from the parent type, which + can be overridden in extensions. */ + genname = tb_io_proc->u.generic->specific_st->name; + st = gfc_find_typebound_proc (derived, NULL, genname, + true, &tb_io_proc->where); + if (st) + dtio_sub = st->n.tb->u.specific->n.sym; + else + dtio_sub = specific_proc->u.specific->n.sym; + + goto finish; + } + + /* If there is not a typebound binding, look for a generic + DTIO interface. */ + for (extended = derived; extended; + extended = gfc_get_derived_super_type (extended)) + { + if (extended == NULL || extended->ns == NULL + || extended->attr.flavor == FL_UNKNOWN) + return NULL; + + if (formatted == true) + { + if (write == true) + tb_io_st = gfc_find_symtree (extended->ns->sym_root, + gfc_code2string (dtio_procs, + DTIO_WF)); + else + tb_io_st = gfc_find_symtree (extended->ns->sym_root, + gfc_code2string (dtio_procs, + DTIO_RF)); + } + else + { + if (write == true) + tb_io_st = gfc_find_symtree (extended->ns->sym_root, + gfc_code2string (dtio_procs, + DTIO_WUF)); + else + tb_io_st = gfc_find_symtree (extended->ns->sym_root, + gfc_code2string (dtio_procs, + DTIO_RUF)); + } + + if (tb_io_st != NULL + && tb_io_st->n.sym + && tb_io_st->n.sym->generic) + { + for (gfc_interface *intr = tb_io_st->n.sym->generic; + intr && intr->sym; intr = intr->next) + { + if (intr->sym->formal) + { + gfc_symbol *fsym = intr->sym->formal->sym; + if ((fsym->ts.type == BT_CLASS + && CLASS_DATA (fsym)->ts.u.derived == extended) + || (fsym->ts.type == BT_DERIVED + && fsym->ts.u.derived == extended)) + { + dtio_sub = intr->sym; + break; + } + } + } + } + } + +finish: + if (dtio_sub && derived != CLASS_DATA (dtio_sub->formal->sym)->ts.u.derived) + gfc_find_derived_vtab (derived); + + return dtio_sub; +} diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 1d7503dc9f..2f60fe8c87 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1,6 +1,6 @@ /* Build up a list of intrinsic subroutines and functions for the name-resolution stage. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -333,11 +333,11 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type break; case SZ_NOTHING: - next_sym->name = gfc_get_string (name); + next_sym->name = gfc_get_string ("%s", name); strcpy (buf, "_gfortran_"); strcat (buf, name); - next_sym->lib_name = gfc_get_string (buf); + next_sym->lib_name = gfc_get_string ("%s", buf); next_sym->pure = (cl != CLASS_IMPURE); next_sym->elemental = (cl == CLASS_ELEMENTAL); @@ -884,7 +884,7 @@ find_sym (gfc_intrinsic_sym *start, int n, const char *name) /* name may be a user-supplied string, so we must first make sure that we're comparing against a pointer into the global string table. */ - const char *p = gfc_get_string (name); + const char *p = gfc_get_string ("%s", name); while (n > 0) { @@ -1153,7 +1153,7 @@ make_alias (const char *name, int standard) case SZ_NOTHING: next_sym[0] = next_sym[-1]; - next_sym->name = gfc_get_string (name); + next_sym->name = gfc_get_string ("%s", name); next_sym->standard = standard; next_sym++; break; @@ -1239,7 +1239,8 @@ add_functions (void) *z = "z", *ln = "len", *ut = "unit", *han = "handler", *num = "number", *tm = "time", *nm = "name", *md = "mode", *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command", - *ca = "coarray", *sub = "sub", *dist = "distance", *failed="failed"; + *ca = "coarray", *sub = "sub", *dist = "distance", *failed="failed", + *c_ptr_1 = "c_ptr_1", *c_ptr_2 = "c_ptr_2"; int di, dr, dd, dl, dc, dz, ii; @@ -1255,6 +1256,14 @@ add_functions (void) gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs, a, BT_REAL, dr, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("babs", GFC_STD_GNU); + make_alias ("iiabs", GFC_STD_GNU); + make_alias ("jiabs", GFC_STD_GNU); + make_alias ("kiabs", GFC_STD_GNU); + } + add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77, NULL, gfc_simplify_abs, gfc_resolve_abs, a, BT_INTEGER, di, REQUIRED); @@ -1557,6 +1566,14 @@ add_functions (void) gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest, i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("bbtest", GFC_STD_GNU); + make_alias ("bitest", GFC_STD_GNU); + make_alias ("bjtest", GFC_STD_GNU); + make_alias ("bktest", GFC_STD_GNU); + } + make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95); add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95, @@ -1823,6 +1840,13 @@ add_functions (void) a, BT_UNKNOWN, 0, REQUIRED, mo, BT_UNKNOWN, 0, REQUIRED); + add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES, CLASS_TRANSFORMATIONAL, + ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS, + gfc_check_failed_or_stopped_images, + gfc_simplify_failed_or_stopped_images, + gfc_resolve_failed_images, "team", BT_VOID, di, OPTIONAL, + "kind", BT_INTEGER, di, OPTIONAL); + add_sym_0 ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate); @@ -1950,6 +1974,14 @@ add_functions (void) gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand, i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("biand", GFC_STD_GNU); + make_alias ("iiand", GFC_STD_GNU); + make_alias ("jiand", GFC_STD_GNU); + make_alias ("kiand", GFC_STD_GNU); + } + make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95); add_sym_2 ("and", GFC_ISYM_AND, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL, @@ -1981,6 +2013,14 @@ add_functions (void) gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr, i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("bbclr", GFC_STD_GNU); + make_alias ("iibclr", GFC_STD_GNU); + make_alias ("jibclr", GFC_STD_GNU); + make_alias ("kibclr", GFC_STD_GNU); + } + make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95); add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95, @@ -1988,12 +2028,28 @@ add_functions (void) i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED, ln, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("bbits", GFC_STD_GNU); + make_alias ("iibits", GFC_STD_GNU); + make_alias ("jibits", GFC_STD_GNU); + make_alias ("kibits", GFC_STD_GNU); + } + make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95); add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95, gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset, i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("bbset", GFC_STD_GNU); + make_alias ("iibset", GFC_STD_GNU); + make_alias ("jibset", GFC_STD_GNU); + make_alias ("kibset", GFC_STD_GNU); + } + make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95); add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO, @@ -2007,6 +2063,14 @@ add_functions (void) gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor, i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("bieor", GFC_STD_GNU); + make_alias ("iieor", GFC_STD_GNU); + make_alias ("jieor", GFC_STD_GNU); + make_alias ("kieor", GFC_STD_GNU); + } + make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95); add_sym_2 ("xor", GFC_ISYM_XOR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL, @@ -2024,6 +2088,11 @@ add_functions (void) gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index, ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED); + add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO, + BT_INTEGER, di, GFC_STD_F2008_TS, gfc_check_image_status, + gfc_simplify_image_status, gfc_resolve_image_status, "image", + 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_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES, @@ -2072,6 +2141,14 @@ add_functions (void) gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior, i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("bior", GFC_STD_GNU); + make_alias ("iior", GFC_STD_GNU); + make_alias ("jior", GFC_STD_GNU); + make_alias ("kior", GFC_STD_GNU); + } + make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95); add_sym_2 ("or", GFC_ISYM_OR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL, @@ -2139,6 +2216,14 @@ add_functions (void) gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft, i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("bshft", GFC_STD_GNU); + make_alias ("iishft", GFC_STD_GNU); + make_alias ("jishft", GFC_STD_GNU); + make_alias ("kishft", GFC_STD_GNU); + } + make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95); add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95, @@ -2146,6 +2231,14 @@ add_functions (void) i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED, sz, BT_INTEGER, di, OPTIONAL); + if (flag_dec_intrinsic_ints) + { + make_alias ("bshftc", GFC_STD_GNU); + make_alias ("iishftc", GFC_STD_GNU); + make_alias ("jishftc", GFC_STD_GNU); + make_alias ("kishftc", GFC_STD_GNU); + } + make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95); add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, @@ -2456,6 +2549,14 @@ add_functions (void) gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod, a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("bmod", GFC_STD_GNU); + make_alias ("imod", GFC_STD_GNU); + make_alias ("jmod", GFC_STD_GNU); + make_alias ("kmod", GFC_STD_GNU); + } + add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77, NULL, gfc_simplify_mod, gfc_resolve_mod, a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED); @@ -2498,6 +2599,14 @@ add_functions (void) gfc_check_i, gfc_simplify_not, gfc_resolve_not, i, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("bnot", GFC_STD_GNU); + make_alias ("inot", GFC_STD_GNU); + make_alias ("jnot", GFC_STD_GNU); + make_alias ("knot", GFC_STD_GNU); + } + make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95); add_sym_2 ("norm2", GFC_ISYM_NORM2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, @@ -2608,6 +2717,13 @@ add_functions (void) gfc_check_float, gfc_simplify_float, NULL, a, BT_INTEGER, di, REQUIRED); + if (flag_dec_intrinsic_ints) + { + make_alias ("floati", GFC_STD_GNU); + make_alias ("floatj", GFC_STD_GNU); + make_alias ("floatk", GFC_STD_GNU); + } + add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, gfc_check_float, gfc_simplify_dble, gfc_resolve_dble, a, BT_REAL, dr, REQUIRED); @@ -2811,8 +2927,8 @@ add_functions (void) /* The following functions are part of ISO_C_BINDING. */ add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003, gfc_check_c_associated, NULL, NULL, - "C_PTR_1", BT_VOID, 0, REQUIRED, - "C_PTR_2", BT_VOID, 0, OPTIONAL); + c_ptr_1, BT_VOID, 0, REQUIRED, + c_ptr_2, BT_VOID, 0, OPTIONAL); make_from_module(); add_sym_1 ("c_loc", GFC_ISYM_C_LOC, CLASS_INQUIRY, ACTUAL_NO, @@ -2885,6 +3001,13 @@ add_functions (void) make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU); + add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES, CLASS_TRANSFORMATIONAL, + ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS, + gfc_check_failed_or_stopped_images, + gfc_simplify_failed_or_stopped_images, + gfc_resolve_stopped_images, "team", BT_VOID, di, OPTIONAL, + "kind", BT_INTEGER, di, OPTIONAL); + add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008, gfc_check_storage_size, gfc_simplify_storage_size, @@ -3035,6 +3158,117 @@ add_functions (void) make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU); + if (flag_dec_math) + { + add_sym_1 ("acosd", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_atrigd, gfc_resolve_atrigd, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dacosd", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dd, GFC_STD_GNU, + gfc_check_fn_d, gfc_simplify_atrigd, gfc_resolve_atrigd, + x, BT_REAL, dd, REQUIRED); + + make_generic ("acosd", GFC_ISYM_ACOS, GFC_STD_GNU); + + add_sym_1 ("asind", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_atrigd, gfc_resolve_atrigd, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dasind", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dd, GFC_STD_GNU, + gfc_check_fn_d, gfc_simplify_atrigd, gfc_resolve_atrigd, + x, BT_REAL, dd, REQUIRED); + + make_generic ("asind", GFC_ISYM_ASIN, GFC_STD_GNU); + + add_sym_1 ("atand", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_atrigd, gfc_resolve_atrigd, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("datand", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dd, GFC_STD_GNU, + gfc_check_fn_d, gfc_simplify_atrigd, gfc_resolve_atrigd, + x, BT_REAL, dd, REQUIRED); + + make_generic ("atand", GFC_ISYM_ATAN, GFC_STD_GNU); + + add_sym_2 ("atan2d",GFC_ISYM_ATAN2,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_GNU, + gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_atan2d, + y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED); + + add_sym_2 ("datan2d",GFC_ISYM_ATAN2,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dd, GFC_STD_GNU, + gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_atan2d, + y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED); + + make_generic ("atan2d", GFC_ISYM_ATAN2, GFC_STD_GNU); + + add_sym_1 ("cosd", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dcosd", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dd, GFC_STD_GNU, + gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd, + x, BT_REAL, dd, REQUIRED); + + make_generic ("cosd", GFC_ISYM_COS, GFC_STD_GNU); + + add_sym_1 ("cotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_GNU, + gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_cotan, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dd, GFC_STD_GNU, + gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_cotan, + x, BT_REAL, dd, REQUIRED); + + make_generic ("cotan", GFC_ISYM_COTAN, GFC_STD_GNU); + + add_sym_1 ("cotand", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dcotand",GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dd, GFC_STD_GNU, + gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd, + x, BT_REAL, dd, REQUIRED); + + make_generic ("cotand", GFC_ISYM_COTAN, GFC_STD_GNU); + + add_sym_1 ("sind", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dsind", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dd, GFC_STD_GNU, + gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd, + x, BT_REAL, dd, REQUIRED); + + make_generic ("sind", GFC_ISYM_SIN, GFC_STD_GNU); + + add_sym_1 ("tand", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dr, GFC_STD_GNU, + gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd, + x, BT_REAL, dr, REQUIRED); + + add_sym_1 ("dtand", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, + dd, GFC_STD_GNU, + gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd, + x, BT_REAL, dd, REQUIRED); + + make_generic ("tand", GFC_ISYM_TAN, GFC_STD_GNU); + } + /* The following function is internally used for coarray libray functions. "make_from_module" makes it inaccessible for external users. */ add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET, CLASS_IMPURE, ACTUAL_NO, @@ -3306,6 +3540,14 @@ add_subroutines (void) t, BT_INTEGER, di, REQUIRED, INTENT_INOUT, tp, BT_INTEGER, di, REQUIRED, INTENT_IN); + if (flag_dec_intrinsic_ints) + { + make_alias ("bmvbits", GFC_STD_GNU); + make_alias ("imvbits", GFC_STD_GNU); + make_alias ("jmvbits", GFC_STD_GNU); + make_alias ("kmvbits", GFC_STD_GNU); + } + add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL, gfc_resolve_random_number, @@ -4115,6 +4357,15 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e) goto finish; } + /* Some math intrinsics need to wrap the original expression. */ + if (specific->simplify.f1 == gfc_simplify_trigd + || specific->simplify.f1 == gfc_simplify_atrigd + || specific->simplify.f1 == gfc_simplify_cotan) + { + result = (*specific->simplify.f1) (e); + goto finish; + } + if (specific->simplify.f1 == NULL) { result = NULL; @@ -4448,6 +4699,27 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) return MATCH_ERROR; } + /* F95, 7.1.6.1: Only transformational functions REPEAT, RESHAPE, + SELECTED_INT_KIND, SELECTED_REAL_KIND, TRANSFER, and TRIM are allowed in + initialization expressions. */ + + if (gfc_init_expr_flag && isym->transformational) + { + gfc_isym_id id = isym->id; + if (id != GFC_ISYM_REPEAT && id != GFC_ISYM_RESHAPE + && id != GFC_ISYM_SI_KIND && id != GFC_ISYM_SR_KIND + && id != GFC_ISYM_TRANSFER && id != GFC_ISYM_TRIM + && !gfc_notify_std (GFC_STD_F2003, "Transformational function %qs " + "at %L is invalid in an initialization " + "expression", name, &expr->where)) + { + if (!error_flag) + gfc_pop_suppress_errors (); + + return MATCH_ERROR; + } + } + gfc_current_intrinsic_where = &expr->where; /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */ @@ -4752,12 +5024,14 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) new_expr->value.function.name = sym->lib_name; new_expr->value.function.isym = sym; new_expr->where = old_where; + new_expr->ts = *ts; new_expr->rank = rank; new_expr->shape = gfc_copy_shape (shape, rank); gfc_get_ha_sym_tree (sym->name, &new_expr->symtree); new_expr->symtree->n.sym->result = new_expr->symtree->n.sym; - new_expr->symtree->n.sym->ts = *ts; + new_expr->symtree->n.sym->ts.type = ts->type; + new_expr->symtree->n.sym->ts.kind = ts->kind; new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE; new_expr->symtree->n.sym->attr.function = 1; new_expr->symtree->n.sym->attr.elemental = 1; @@ -4823,11 +5097,13 @@ gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts) new_expr->value.function.name = sym->lib_name; new_expr->value.function.isym = sym; new_expr->where = old_where; + new_expr->ts = *ts; new_expr->rank = rank; new_expr->shape = gfc_copy_shape (shape, rank); gfc_get_ha_sym_tree (sym->name, &new_expr->symtree); - new_expr->symtree->n.sym->ts = *ts; + new_expr->symtree->n.sym->ts.type = ts->type; + new_expr->symtree->n.sym->ts.kind = ts->kind; new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE; new_expr->symtree->n.sym->attr.function = 1; new_expr->symtree->n.sym->attr.elemental = 1; diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index f22897654e..e8280f6f2a 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-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -71,6 +71,7 @@ bool gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_dtime_etime (gfc_expr *); bool gfc_check_event_query (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_failed_or_stopped_images (gfc_expr *, gfc_expr *); bool gfc_check_fgetputc (gfc_expr *, gfc_expr *); bool gfc_check_fgetput (gfc_expr *); bool gfc_check_float (gfc_expr *); @@ -92,6 +93,7 @@ bool gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_ichar_iachar (gfc_expr *, gfc_expr *); bool gfc_check_idnint (gfc_expr *); bool gfc_check_ieor (gfc_expr *, gfc_expr *); +bool gfc_check_image_status (gfc_expr *, gfc_expr *); bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_int (gfc_expr *, gfc_expr *); bool gfc_check_intconv (gfc_expr *); @@ -238,6 +240,7 @@ gfc_expr *gfc_simplify_adjustr (gfc_expr *); gfc_expr *gfc_simplify_aimag (gfc_expr *); gfc_expr *gfc_simplify_aint (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_all (gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_atrigd (gfc_expr *); gfc_expr *gfc_simplify_dint (gfc_expr *); gfc_expr *gfc_simplify_anint (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_dnint (gfc_expr *); @@ -248,6 +251,7 @@ gfc_expr *gfc_simplify_asinh (gfc_expr *); gfc_expr *gfc_simplify_atan (gfc_expr *); gfc_expr *gfc_simplify_atanh (gfc_expr *); gfc_expr *gfc_simplify_atan2 (gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_atan2d (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_bessel_j0 (gfc_expr *); gfc_expr *gfc_simplify_bessel_j1 (gfc_expr *); gfc_expr *gfc_simplify_bessel_jn (gfc_expr *, gfc_expr *); @@ -271,6 +275,7 @@ gfc_expr *gfc_simplify_complex (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_conjg (gfc_expr *); gfc_expr *gfc_simplify_cos (gfc_expr *); gfc_expr *gfc_simplify_cosh (gfc_expr *); +gfc_expr *gfc_simplify_cotan (gfc_expr *); gfc_expr *gfc_simplify_count (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_cshift (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_dcmplx (gfc_expr *, gfc_expr *); @@ -289,6 +294,7 @@ gfc_expr *gfc_simplify_erfc_scaled (gfc_expr *); gfc_expr *gfc_simplify_exp (gfc_expr *); gfc_expr *gfc_simplify_exponent (gfc_expr *); gfc_expr *gfc_simplify_extends_type_of (gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_failed_or_stopped_images (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_float (gfc_expr *); gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_fraction (gfc_expr *); @@ -305,6 +311,7 @@ gfc_expr *gfc_simplify_ibset (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ichar (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ieor (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_image_index (gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_image_status (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_int2 (gfc_expr *); @@ -401,6 +408,7 @@ gfc_expr *gfc_simplify_tiny (gfc_expr *); gfc_expr *gfc_simplify_trailz (gfc_expr *); gfc_expr *gfc_simplify_transfer (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_transpose (gfc_expr *); +gfc_expr *gfc_simplify_trigd (gfc_expr *); gfc_expr *gfc_simplify_trim (gfc_expr *); gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ucobound (gfc_expr *, gfc_expr *, gfc_expr *); @@ -434,6 +442,7 @@ 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 *); @@ -452,6 +461,7 @@ void gfc_resolve_conjg (gfc_expr *, gfc_expr *); void gfc_resolve_cos (gfc_expr *, gfc_expr *); void gfc_resolve_cosh (gfc_expr *, gfc_expr *); void gfc_resolve_count (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_cotan (gfc_expr *, gfc_expr *); void gfc_resolve_cshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ctime (gfc_expr *, gfc_expr *); void gfc_resolve_dble (gfc_expr *, gfc_expr *); @@ -467,6 +477,7 @@ void gfc_resolve_event_query (gfc_code *); void gfc_resolve_exp (gfc_expr *, gfc_expr *); void gfc_resolve_exponent (gfc_expr *, gfc_expr *); void gfc_resolve_extends_type_of (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_failed_images (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_fdate (gfc_expr *); void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_fnum (gfc_expr *, gfc_expr *); @@ -490,6 +501,7 @@ void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *); 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_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ierrno (gfc_expr *); @@ -565,12 +577,13 @@ void gfc_resolve_signal (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_sin (gfc_expr *, gfc_expr *); void gfc_resolve_sinh (gfc_expr *, gfc_expr *); void gfc_resolve_size (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -void gfc_resolve_stride (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_spacing (gfc_expr *, gfc_expr *); void gfc_resolve_spread (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_sqrt (gfc_expr *, gfc_expr *); void gfc_resolve_stat (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_stopped_images (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_storage_size (gfc_expr *f, gfc_expr *a, gfc_expr *kind); +void gfc_resolve_stride (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_srand (gfc_code *); void gfc_resolve_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_symlnk (gfc_expr *, gfc_expr *, gfc_expr *); @@ -582,6 +595,8 @@ void gfc_resolve_time (gfc_expr *); void gfc_resolve_time8 (gfc_expr *); void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_transpose (gfc_expr *, gfc_expr *); +void gfc_resolve_trigd (gfc_expr *, gfc_expr *); +void gfc_resolve_atrigd (gfc_expr *, gfc_expr *); void gfc_resolve_trim (gfc_expr *, gfc_expr *); void gfc_resolve_ttynam (gfc_expr *, gfc_expr *); void gfc_resolve_ubound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 88406301d9..c1de29eaaa 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -1,5 +1,5 @@ @ignore -Copyright (C) 2005-2016 Free Software Foundation, Inc. +Copyright (C) 2005-2017 Free Software Foundation, Inc. This is part of the GNU Fortran manual. For copying conditions, see the file gfortran.texi. @@ -23,12 +23,16 @@ Some basic guidelines for editing this document: @end ignore @tex +\gdef\acosd{\mathop{\rm acosd}\nolimits} +\gdef\asind{\mathop{\rm asind}\nolimits} +\gdef\atand{\mathop{\rm atand}\nolimits} \gdef\acos{\mathop{\rm acos}\nolimits} \gdef\asin{\mathop{\rm asin}\nolimits} \gdef\atan{\mathop{\rm atan}\nolimits} \gdef\acosh{\mathop{\rm acosh}\nolimits} \gdef\asinh{\mathop{\rm asinh}\nolimits} \gdef\atanh{\mathop{\rm atanh}\nolimits} +\gdef\cosd{\mathop{\rm cosd}\nolimits} @end tex @@ -43,6 +47,7 @@ Some basic guidelines for editing this document: * @code{ACCESS}: ACCESS, Checks file access modes * @code{ACHAR}: ACHAR, Character in @acronym{ASCII} collating sequence * @code{ACOS}: ACOS, Arccosine function +* @code{ACOSD}: ACOSD, Arccosine function, degrees * @code{ACOSH}: ACOSH, Inverse hyperbolic cosine function * @code{ADJUSTL}: ADJUSTL, Left adjust a string * @code{ADJUSTR}: ADJUSTR, Right adjust a string @@ -55,10 +60,13 @@ Some basic guidelines for editing this document: * @code{ANINT}: ANINT, Nearest whole number * @code{ANY}: ANY, Determine if any values are true * @code{ASIN}: ASIN, Arcsine function +* @code{ASIND}: ASIND, Arcsine function, degrees * @code{ASINH}: ASINH, Inverse hyperbolic sine function * @code{ASSOCIATED}: ASSOCIATED, Status of a pointer or pointer/target pair * @code{ATAN}: ATAN, Arctangent function +* @code{ATAND}: ATAND, Arctangent function, degrees * @code{ATAN2}: ATAN2, Arctangent function +* @code{ATAN2D}: ATAN2D, Arctangent function, degrees * @code{ATANH}: ATANH, Inverse hyperbolic tangent function * @code{ATOMIC_ADD}: ATOMIC_ADD, Atomic ADD operation * @code{ATOMIC_AND}: ATOMIC_AND, Atomic bitwise AND operation @@ -106,7 +114,10 @@ Some basic guidelines for editing this document: * @code{COMPLEX}: COMPLEX, Complex conversion function * @code{CONJG}: CONJG, Complex conjugate function * @code{COS}: COS, Cosine function +* @code{COSD}: COSD, Cosine function, degrees * @code{COSH}: COSH, Hyperbolic cosine function +* @code{COTAN}: COTAN, Cotangent function +* @code{COTAND}: COTAND, Cotangent function, degrees * @code{COUNT}: COUNT, Count occurrences of TRUE in an array * @code{CPU_TIME}: CPU_TIME, CPU time subroutine * @code{CSHIFT}: CSHIFT, Circular shift elements of an array @@ -277,6 +288,7 @@ Some basic guidelines for editing this document: * @code{SIGN}: SIGN, Sign copying function * @code{SIGNAL}: SIGNAL, Signal handling subroutine (or function) * @code{SIN}: SIN, Sine function +* @code{SIND}: SIND, Sine function, degrees * @code{SINH}: SINH, Hyperbolic sine function * @code{SIZE}: SIZE, Function to determine the size of an array * @code{SIZEOF}: SIZEOF, Determine the size in bytes of an expression @@ -292,6 +304,7 @@ Some basic guidelines for editing this document: * @code{SYSTEM}: SYSTEM, Execute a shell command * @code{SYSTEM_CLOCK}: SYSTEM_CLOCK, Time function * @code{TAN}: TAN, Tangent function +* @code{TAND}: TAND, Tangent function, degrees * @code{TANH}: TANH, Hyperbolic tangent function * @code{THIS_IMAGE}: THIS_IMAGE, Cosubscript index of this image * @code{TIME}: TIME, Time function @@ -401,6 +414,10 @@ end program test_abort @fnindex IABS @fnindex ZABS @fnindex CDABS +@fnindex BABS +@fnindex IIABS +@fnindex JIABS +@fnindex KIABS @cindex absolute value @table @asis @@ -446,6 +463,10 @@ end program test_abs @item @code{CABS(A)} @tab @code{COMPLEX(4) A} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DABS(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)} @tab Fortran 77 and later @item @code{IABS(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab Fortran 77 and later +@item @code{BABS(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IIABS(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JIABS(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KIABS(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension @item @code{ZABS(A)} @tab @code{COMPLEX(8) A} @tab @code{COMPLEX(8)} @tab GNU extension @item @code{CDABS(A)} @tab @code{COMPLEX(8) A} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable @@ -611,6 +632,65 @@ end program test_acos @item @emph{See also}: Inverse function: @ref{COS} +Degrees function: @ref{ACOSD} + +@end table + + + +@node ACOSD +@section @code{ACOSD} --- Arccosine function, degrees +@fnindex ACOSD +@fnindex DACOSD +@cindex trigonometric function, cosine, inverse, degrees +@cindex cosine, inverse, degrees + +@table @asis +@item @emph{Description}: +@code{ACOSD(X)} computes the arccosine of @var{X} in degrees (inverse of +@code{COSD(X)}). + +This function is for compatibility only and should be avoided in favor of +standard constructs wherever possible. + +@item @emph{Standard}: +GNU Extension, enabled with @option{-fdec-math} + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = ACOSD(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{X} @tab The type shall either be @code{REAL} with a magnitude that is +less than or equal to one - or the type shall be @code{COMPLEX}. +@end multitable + +@item @emph{Return value}: +The return value is of the same type and kind as @var{X}. +The real part of the result is in degrees and lies in the range +@math{0 \leq \Re \acos(x) \leq 180}. + +@item @emph{Example}: +@smallexample +program test_acosd + real(8) :: x = 0.866_8 + x = acosd(x) +end program test_acosd +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@end multitable + +@item @emph{See also}: +Inverse function: @ref{COSD} +Radians function: @ref{ACOS} @end table @@ -1261,6 +1341,65 @@ end program test_asin @item @emph{See also}: Inverse function: @ref{SIN} +Degrees function: @ref{ASIND} + +@end table + + + +@node ASIND +@section @code{ASIND} --- Arcsine function, degrees +@fnindex ASIND +@fnindex DASIND +@cindex trigonometric function, sine, inverse, degrees +@cindex sine, inverse, degrees + +@table @asis +@item @emph{Description}: +@code{ASIND(X)} computes the arcsine of its @var{X} in degrees (inverse of +@code{SIND(X)}). + +This function is for compatibility only and should be avoided in favor of +standard constructs wherever possible. + +@item @emph{Standard}: +GNU Extension, enabled with @option{-fdec-math}. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = ASIND(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{X} @tab The type shall be either @code{REAL} and a magnitude that is +less than or equal to one - or be @code{COMPLEX}. +@end multitable + +@item @emph{Return value}: +The return value is of the same type and kind as @var{X}. +The real part of the result is in degrees and lies in the range +@math{-90 \leq \Re \asin(x) \leq 90}. + +@item @emph{Example}: +@smallexample +program test_asind + real(8) :: x = 0.866_8 + x = asind(x) +end program test_asind +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@end multitable + +@item @emph{See also}: +Inverse function: @ref{SIND} +Radians function: @ref{ASIN} @end table @@ -1450,6 +1589,71 @@ end program test_atan @item @emph{See also}: Inverse function: @ref{TAN} +Degrees function: @ref{ATAND} + +@end table + + + +@node ATAND +@section @code{ATAND} --- Arctangent function, degrees +@fnindex ATAND +@fnindex DATAND +@cindex trigonometric function, tangent, inverse, degrees +@cindex tangent, inverse, degrees + +@table @asis +@item @emph{Description}: +@code{ATAND(X)} computes the arctangent of @var{X} in degrees (inverse of +@ref{TAND}). + +This function is for compatibility only and should be avoided in favor of +standard constructs wherever possible. + +@item @emph{Standard}: +GNU Extension, enabled with @option{-fdec-math}. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@multitable @columnfractions .80 +@item @code{RESULT = ATAND(X)} +@item @code{RESULT = ATAND(Y, X)} +@end multitable + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}; +if @var{Y} is present, @var{X} shall be REAL. +@item @var{Y} shall be of the same type and kind as @var{X}. +@end multitable + +@item @emph{Return value}: +The return value is of the same type and kind as @var{X}. +If @var{Y} is present, the result is identical to @code{ATAND2(Y,X)}. +Otherwise, it is the arcus tangent of @var{X}, where the real part of +the result is in degrees and lies in the range +@math{-90 \leq \Re \atand(x) \leq 90}. + +@item @emph{Example}: +@smallexample +program test_atand + real(8) :: x = 2.866_8 + x = atand(x) +end program test_atand +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@end multitable + +@item @emph{See also}: +Inverse function: @ref{TAND} +Radians function: @ref{ATAN} @end table @@ -1465,7 +1669,7 @@ Inverse function: @ref{TAN} @table @asis @item @emph{Description}: @code{ATAN2(Y, X)} computes the principal value of the argument -function of the complex number @math{X + i Y}. This function can +function of the complex number @math{X + i Y}. This function can be used to transform from Cartesian into polar coordinates and allows to determine the angle in the correct quadrant. @@ -1510,6 +1714,78 @@ end program test_atan2 @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 @end multitable + +@item @emph{See also}: +Alias: @ref{ATAN} +Degrees function: @ref{ATAN2D} + +@end table + + + +@node ATAN2D +@section @code{ATAN2D} --- Arctangent function, degrees +@fnindex ATAN2D +@fnindex DATAN2D +@cindex trigonometric function, tangent, inverse, degrees +@cindex tangent, inverse, degrees + +@table @asis +@item @emph{Description}: +@code{ATAN2D(Y, X)} computes the principal value of the argument +function of the complex number @math{X + i Y} in degrees. This function can +be used to transform from Cartesian into polar coordinates and +allows to determine the angle in the correct quadrant. + +This function is for compatibility only and should be avoided in favor of +standard constructs wherever possible. + +@item @emph{Standard}: +GNU Extension, enabled with @option{-fdec-math}. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = ATAN2D(Y, X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{Y} @tab The type shall be @code{REAL}. +@item @var{X} @tab The type and kind type parameter shall be the same as @var{Y}. +If @var{Y} is zero, then @var{X} must be nonzero. +@end multitable + +@item @emph{Return value}: +The return value has the same type and kind type parameter as @var{Y}. It +is the principal value of the complex number @math{X + i Y}. If @var{X} +is nonzero, then it lies in the range @math{-180 \le \atan (x) \leq 180}. +The sign is positive if @var{Y} is positive. If @var{Y} is zero, then +the return value is zero if @var{X} is strictly positive, @math{180} if +@var{X} is negative and @var{Y} is positive zero (or the processor does +not handle signed zeros), and @math{-180} if @var{X} is negative and +@var{Y} is negative zero. Finally, if @var{X} is zero, then the +magnitude of the result is @math{90}. + +@item @emph{Example}: +@smallexample +program test_atan2d + real(4) :: x = 1.e0_4, y = 0.5e0_4 + x = atan2d(y,x) +end program test_atan2d +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@end multitable + +@item @emph{See also}: +Alias: @ref{ATAND} +Radians function: @ref{ATAN2} + @end table @@ -1574,8 +1850,8 @@ Inverse function: @ref{TANH} @table @asis @item @emph{Description}: @code{ATOMIC_ADD(ATOM, VALUE)} atomically adds the value of @var{VAR} to the -variable @var{ATOM}. When @var{STAT} is present and the invokation was -successful, it is assigned the value 0. If it is present and the invokation +variable @var{ATOM}. When @var{STAT} is present and the invocation was +successful, it is assigned the value 0. If it is present and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has @@ -1625,8 +1901,8 @@ end program atomic @item @emph{Description}: @code{ATOMIC_AND(ATOM, VALUE)} atomically defines @var{ATOM} with the bitwise AND between the values of @var{ATOM} and @var{VALUE}. When @var{STAT} is present -and the invokation was successful, it is assigned the value 0. If it is present -and the invokation has failed, it is assigned a positive value; in particular, +and the invocation was successful, it is assigned the value 0. If it is present +and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has failed, the value @code{STAT_FAILED_IMAGE}. @@ -1675,8 +1951,8 @@ end program atomic @code{ATOMIC_CAS} compares the variable @var{ATOM} with the value of @var{COMPARE}; if the value is the same, @var{ATOM} is set to the value of @var{NEW}. Additionally, @var{OLD} is set to the value of @var{ATOM} -that was used for the comparison. When @var{STAT} is present and the invokation -was successful, it is assigned the value 0. If it is present and the invokation +that was used for the comparison. When @var{STAT} is present and the invocation +was successful, it is assigned the value 0. If it is present and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has @@ -1727,8 +2003,8 @@ end program atomic @table @asis @item @emph{Description}: @code{ATOMIC_DEFINE(ATOM, VALUE)} defines the variable @var{ATOM} with the value -@var{VALUE} atomically. When @var{STAT} is present and the invokation was -successful, it is assigned the value 0. If it is present and the invokation +@var{VALUE} atomically. When @var{STAT} is present and the invocation was +successful, it is assigned the value 0. If it is present and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has @@ -1779,8 +2055,8 @@ end program atomic @item @emph{Description}: @code{ATOMIC_FETCH_ADD(ATOM, VALUE, OLD)} atomically stores the value of @var{ATOM} in @var{OLD} and adds the value of @var{VAR} to the -variable @var{ATOM}. When @var{STAT} is present and the invokation was -successful, it is assigned the value 0. If it is present and the invokation +variable @var{ATOM}. When @var{STAT} is present and the invocation was +successful, it is assigned the value 0. If it is present and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has @@ -1832,8 +2108,8 @@ end program atomic @item @emph{Description}: @code{ATOMIC_AND(ATOM, VALUE)} atomically stores the value of @var{ATOM} in @var{OLD} and defines @var{ATOM} with the bitwise AND between the values of -@var{ATOM} and @var{VALUE}. When @var{STAT} is present and the invokation was -successful, it is assigned the value 0. If it is present and the invokation has +@var{ATOM} and @var{VALUE}. When @var{STAT} is present and the invocation was +successful, it is assigned the value 0. If it is present and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has @@ -1883,8 +2159,8 @@ end program atomic @item @emph{Description}: @code{ATOMIC_OR(ATOM, VALUE)} atomically stores the value of @var{ATOM} in @var{OLD} and defines @var{ATOM} with the bitwise OR between the values of -@var{ATOM} and @var{VALUE}. When @var{STAT} is present and the invokation was -successful, it is assigned the value 0. If it is present and the invokation has +@var{ATOM} and @var{VALUE}. When @var{STAT} is present and the invocation was +successful, it is assigned the value 0. If it is present and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has @@ -1934,8 +2210,8 @@ end program atomic @item @emph{Description}: @code{ATOMIC_XOR(ATOM, VALUE)} atomically stores the value of @var{ATOM} in @var{OLD} and defines @var{ATOM} with the bitwise XOR between the values of -@var{ATOM} and @var{VALUE}. When @var{STAT} is present and the invokation was -successful, it is assigned the value 0. If it is present and the invokation has +@var{ATOM} and @var{VALUE}. When @var{STAT} is present and the invocation was +successful, it is assigned the value 0. If it is present and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has @@ -1985,8 +2261,8 @@ end program atomic @item @emph{Description}: @code{ATOMIC_OR(ATOM, VALUE)} atomically defines @var{ATOM} with the bitwise AND between the values of @var{ATOM} and @var{VALUE}. When @var{STAT} is present -and the invokation was successful, it is assigned the value 0. If it is present -and the invokation has failed, it is assigned a positive value; in particular, +and the invocation was successful, it is assigned the value 0. If it is present +and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has failed, the value @code{STAT_FAILED_IMAGE}. @@ -2034,8 +2310,8 @@ end program atomic @item @emph{Description}: @code{ATOMIC_DEFINE(ATOM, VALUE)} atomically assigns the value of the variable @var{ATOM} to @var{VALUE}. When @var{STAT} is present and the -invokation was successful, it is assigned the value 0. If it is present and the -invokation has failed, it is assigned a positive value; in particular, for a +invocation was successful, it is assigned the value 0. If it is present and the +invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has failed, the value @code{STAT_FAILED_IMAGE}. @@ -2091,8 +2367,8 @@ end program atomic @item @emph{Description}: @code{ATOMIC_AND(ATOM, VALUE)} atomically defines @var{ATOM} with the bitwise XOR between the values of @var{ATOM} and @var{VALUE}. When @var{STAT} is present -and the invokation was successful, it is assigned the value 0. If it is present -and the invokation has failed, it is assigned a positive value; in particular, +and the invocation was successful, it is assigned the value 0. If it is present +and the invocation has failed, it is assigned a positive value; in particular, for a coindexed @var{ATOM}, if the remote image has stopped, it is assigned the value of @code{ISO_FORTRAN_ENV}'s @code{STAT_STOPPED_IMAGE} and if the remote image has failed, the value @code{STAT_FAILED_IMAGE}. @@ -2666,6 +2942,10 @@ The return value is of type @code{LOGICAL} and of the default kind. @node BTEST @section @code{BTEST} --- Bit test function @fnindex BTEST +@fnindex BBTEST +@fnindex BITEST +@fnindex BJTEST +@fnindex BKTEST @cindex bits, testing @table @asis @@ -2674,7 +2954,7 @@ The return value is of type @code{LOGICAL} and of the default kind. in @var{I} is set. The counting of the bits starts at 0. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -2703,8 +2983,17 @@ program test_btest end do end program test_btest @end smallexample -@end table +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{BTEST(I,POS)} @tab @code{INTEGER I,POS} @tab @code{LOGICAL} @tab F95 and later +@item @code{BBTEST(I,POS)} @tab @code{INTEGER(1) I,POS} @tab @code{LOGICAL(1)} @tab GNU extension +@item @code{BITEST(I,POS)} @tab @code{INTEGER(2) I,POS} @tab @code{LOGICAL(2)} @tab GNU extension +@item @code{BJTEST(I,POS)} @tab @code{INTEGER(4) I,POS} @tab @code{LOGICAL(4)} @tab GNU extension +@item @code{BKTEST(I,POS)} @tab @code{INTEGER(8) I,POS} @tab @code{LOGICAL(8)} @tab GNU extension +@end multitable +@end table @node C_ASSOCIATED @section @code{C_ASSOCIATED} --- Status of a C pointer @@ -3874,6 +4163,70 @@ end program test_cos @item @emph{See also}: Inverse function: @ref{ACOS} +Degrees function: @ref{COSD} + +@end table + + + +@node COSD +@section @code{COSD} --- Cosine function, degrees +@fnindex COSD +@fnindex DCOSD +@fnindex CCOSD +@fnindex ZCOSD +@fnindex CDCOSD +@cindex trigonometric function, cosine, degrees +@cindex cosine, degrees + +@table @asis +@item @emph{Description}: +@code{COSD(X)} computes the cosine of @var{X} in degrees. + +This function is for compatibility only and should be avoided in favor of +standard constructs wherever possible. + +@item @emph{Standard}: +GNU Extension, enabled with @option{-fdec-math}. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = COSD(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{X} @tab The type shall be @code{REAL} or +@code{COMPLEX}. +@end multitable + +@item @emph{Return value}: +The return value is of the same type and kind as @var{X}. The real part +of the result is in degrees. If @var{X} is of the type @code{REAL}, +the return value lies in the range @math{ -1 \leq \cosd (x) \leq 1}. + +@item @emph{Example}: +@smallexample +program test_cosd + real :: x = 0.0 + x = cosd(x) +end program test_cosd +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@item @code{CCOSD(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab GNU Extension +@item @code{ZCOSD(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension +@item @code{CDCOSD(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension +@end multitable + +@item @emph{See also}: +Inverse function: @ref{ACOSD} +Radians function: @ref{COS} @end table @@ -3933,6 +4286,115 @@ Inverse function: @ref{ACOSH} +@node COTAN +@section @code{COTAN} --- Cotangent function +@fnindex COTAN +@fnindex DCOTAN +@cindex trigonometric function, cotangent +@cindex cotangent + +@table @asis +@item @emph{Description}: +@code{COTAN(X)} computes the cotangent of @var{X}. Equivalent to @code{COS(x)} +divided by @code{SIN(x)}, or @code{1 / TAN(x)}. + +This function is for compatibility only and should be avoided in favor of +standard constructs wherever possible. + +@item @emph{Standard}: +GNU Extension, enabled with @option{-fdec-math}. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = COTAN(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}. +@end multitable + +@item @emph{Return value}: +The return value has same type and kind as @var{X}, and its value is in radians. + +@item @emph{Example}: +@smallexample +program test_cotan + real(8) :: x = 0.165_8 + x = cotan(x) +end program test_cotan +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@end multitable + +@item @emph{See also}: +Converse function: @ref{TAN} +Degrees function: @ref{COTAND} +@end table + + + +@node COTAND +@section @code{COTAND} --- Cotangent function, degrees +@fnindex COTAND +@fnindex DCOTAND +@cindex trigonometric function, cotangent, degrees +@cindex cotangent, degrees + +@table @asis +@item @emph{Description}: +@code{COTAND(X)} computes the cotangent of @var{X} in degrees. Equivalent to +@code{COSD(x)} divided by @code{SIND(x)}, or @code{1 / TAND(x)}. + +@item @emph{Standard}: +GNU Extension, enabled with @option{-fdec-math}. + +This function is for compatibility only and should be avoided in favor of +standard constructs wherever possible. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = COTAND(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}. +@end multitable + +@item @emph{Return value}: +The return value has same type and kind as @var{X}, and its value is in degrees. + +@item @emph{Example}: +@smallexample +program test_cotand + real(8) :: x = 0.165_8 + x = cotand(x) +end program test_cotand +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@end multitable + +@item @emph{See also}: +Converse function: @ref{TAND} +Radians function: @ref{COTAN} + +@end table + + + @node COUNT @section @code{COUNT} --- Count function @fnindex COUNT @@ -4121,7 +4583,7 @@ end program test_cshift @table @asis @item @emph{Description}: @code{CTIME} converts a system time value, such as returned by -@code{TIME8}, to a string. The output will be of the form @samp{Sat +@ref{TIME8}, to a string. The output will be of the form @samp{Sat Aug 19 18:13:14 1995}. This intrinsic is provided in both subroutine and function forms; however, @@ -5073,8 +5535,8 @@ end program test_etime @item @emph{Description}: @code{EVENT_QUERY} assignes the number of events to @var{COUNT} which have been posted to the @var{EVENT} variable and not yet been removed by calling -@code{EVENT WAIT}. When @var{STAT} is present and the invokation was successful, -it is assigned the value 0. If it is present and the invokation has failed, +@code{EVENT WAIT}. When @var{STAT} is present and the invocation was successful, +it is assigned the value 0. If it is present and the invocation has failed, it is assigned a positive value and @var{COUNT} is assigned the value @math{-1}. @item @emph{Standard}: @@ -5381,7 +5843,7 @@ the dynamic type of A is an extension type of the dynamic type of MOLD. @table @asis @item @emph{Description}: @code{FDATE(DATE)} returns the current date (using the same format as -@code{CTIME}) in @var{DATE}. It is equivalent to @code{CALL CTIME(DATE, +@ref{CTIME}) in @var{DATE}. It is equivalent to @code{CALL CTIME(DATE, TIME())}. This intrinsic is provided in both subroutine and function forms; however, @@ -6695,11 +7157,16 @@ See @code{GETPID} for an example. @table @asis @item @emph{Description}: -Given a system time value @var{TIME} (as provided by the @code{TIME8} +Given a system time value @var{TIME} (as provided by the @ref{TIME} intrinsic), fills @var{VALUES} with values extracted from it appropriate to the UTC time zone (Universal Coordinated Time, also known in some countries as GMT, Greenwich Mean Time), using @code{gmtime(3)}. +This intrinsic routine is provided for backwards compatibility with +GNU Fortran 77. In new code, programmers should consider the use of +the @ref{DATE_AND_TIME} intrinsic defined by the Fortran 95 +standard. + @item @emph{Standard}: GNU extension @@ -6724,17 +7191,17 @@ The elements of @var{VALUES} are assigned as follows: seconds @item Minutes after the hour, range 0--59 @item Hours past midnight, range 0--23 -@item Day of month, range 0--31 -@item Number of months since January, range 0--12 +@item Day of month, range 1--31 +@item Number of months since January, range 0--11 @item Years since 1900 @item Number of days since Sunday, range 0--6 -@item Days since January 1 +@item Days since January 1, range 0--365 @item Daylight savings indicator: positive if daylight savings is in effect, zero if not, and negative if the information is not available. @end enumerate @item @emph{See also}: -@ref{CTIME}, @ref{LTIME}, @ref{TIME}, @ref{TIME8} +@ref{DATE_AND_TIME}, @ref{CTIME}, @ref{LTIME}, @ref{TIME}, @ref{TIME8} @end table @@ -6972,6 +7439,10 @@ END PROGRAM @node IAND @section @code{IAND} --- Bitwise logical and @fnindex IAND +@fnindex BIAND +@fnindex IIAND +@fnindex JIAND +@fnindex KIAND @cindex bitwise logical and @cindex logical and, bitwise @@ -6980,7 +7451,7 @@ END PROGRAM Bitwise logical @code{AND}. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -7010,6 +7481,16 @@ PROGRAM test_iand END PROGRAM @end smallexample +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{IAND(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later +@item @code{BIAND(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IIAND(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JIAND(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KIAND(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{IOR}, @ref{IEOR}, @ref{IBITS}, @ref{IBSET}, @ref{IBCLR}, @ref{NOT} @@ -7124,6 +7605,10 @@ Fortran 2003 functions and subroutines: @ref{GET_COMMAND}, @node IBCLR @section @code{IBCLR} --- Clear bit @fnindex IBCLR +@fnindex BBCLR +@fnindex IIBCLR +@fnindex JIBCLR +@fnindex KIBCLR @cindex bits, unset @cindex bits, clear @@ -7133,7 +7618,7 @@ Fortran 2003 functions and subroutines: @ref{GET_COMMAND}, @var{POS} set to zero. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -7151,6 +7636,16 @@ Elemental function 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 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{IBCLR(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later +@item @code{BBCLR(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IIBCLR(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JIBCLR(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KIBCLR(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{IBITS}, @ref{IBSET}, @ref{IAND}, @ref{IOR}, @ref{IEOR}, @ref{MVBITS} @@ -7161,6 +7656,10 @@ The return value is of type @code{INTEGER} and of the same kind as @node IBITS @section @code{IBITS} --- Bit extraction @fnindex IBITS +@fnindex BBITS +@fnindex IIBITS +@fnindex JIBITS +@fnindex KIBITS @cindex bits, get @cindex bits, extract @@ -7173,7 +7672,7 @@ zeroed. The value of @code{POS+LEN} must be less than or equal to the value @code{BIT_SIZE(I)}. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -7192,6 +7691,16 @@ Elemental function 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 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{IBITS(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later +@item @code{BBITS(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IIBITS(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JIBITS(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KIBITS(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{BIT_SIZE}, @ref{IBCLR}, @ref{IBSET}, @ref{IAND}, @ref{IOR}, @ref{IEOR} @end table @@ -7201,6 +7710,10 @@ The return value is of type @code{INTEGER} and of the same kind as @node IBSET @section @code{IBSET} --- Set bit @fnindex IBSET +@fnindex BBSET +@fnindex IIBSET +@fnindex JIBSET +@fnindex KIBSET @cindex bits, set @table @asis @@ -7209,7 +7722,7 @@ The return value is of type @code{INTEGER} and of the same kind as @var{POS} set to one. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -7227,6 +7740,16 @@ Elemental function 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 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{IBSET(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later +@item @code{BBSET(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IIBSET(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JIBSET(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KIBSET(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{IBCLR}, @ref{IBITS}, @ref{IAND}, @ref{IOR}, @ref{IEOR}, @ref{MVBITS} @@ -7323,6 +7846,11 @@ current local time. The day (in the range 1-31), month (in the range 1-12), and year appear in elements 1, 2, and 3 of @var{VALUES}, respectively. The year has four significant digits. +This intrinsic routine is provided for backwards compatibility with +GNU Fortran 77. In new code, programmers should consider the use of +the @ref{DATE_AND_TIME} intrinsic defined by the Fortran 95 +standard. + @item @emph{Standard}: GNU extension @@ -7351,13 +7879,19 @@ program test_idate print *, tarray(3) end program test_idate @end smallexample -@end table +@item @emph{See also}: +@ref{DATE_AND_TIME} +@end table @node IEOR @section @code{IEOR} --- Bitwise logical exclusive or @fnindex IEOR +@fnindex BIEOR +@fnindex IIEOR +@fnindex JIEOR +@fnindex KIEOR @cindex bitwise logical exclusive or @cindex logical exclusive or, bitwise @@ -7367,7 +7901,7 @@ end program test_idate @var{J}. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -7388,6 +7922,16 @@ The return type is @code{INTEGER}, of the same kind as the arguments. (If the argument kinds differ, it is of the same kind as the larger argument.) +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{IEOR(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later +@item @code{BIEOR(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IIEOR(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JIEOR(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KIEOR(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{IOR}, @ref{IAND}, @ref{IBITS}, @ref{IBSET}, @ref{IBCLR}, @ref{NOT} @end table @@ -7662,6 +8206,10 @@ The return value is a @code{INTEGER(8)} variable. @node IOR @section @code{IOR} --- Bitwise logical or @fnindex IOR +@fnindex BIOR +@fnindex IIOR +@fnindex JIOR +@fnindex KIOR @cindex bitwise logical or @cindex logical or, bitwise @@ -7671,7 +8219,7 @@ The return value is a @code{INTEGER(8)} variable. @var{J}. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -7692,6 +8240,16 @@ The return type is @code{INTEGER}, of the same kind as the arguments. (If the argument kinds differ, it is of the same kind as the larger argument.) +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{IOR(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later +@item @code{BIOR(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IIOR(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JIOR(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KIOR(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{IEOR}, @ref{IAND}, @ref{IBITS}, @ref{IBSET}, @ref{IBCLR}, @ref{NOT} @end table @@ -7945,6 +8503,10 @@ END PROGRAM @node ISHFT @section @code{ISHFT} --- Shift bits @fnindex ISHFT +@fnindex BSHFT +@fnindex IISHFT +@fnindex JISHFT +@fnindex KISHFT @cindex bits, shift @table @asis @@ -7958,7 +8520,7 @@ value is undefined. Bits shifted out from the left end or right end are lost; zeros are shifted in from the opposite end. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -7976,6 +8538,16 @@ Elemental function 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 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{ISHFT(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later +@item @code{BSHFT(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IISHFT(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JISHFT(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KISHFT(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{ISHFTC} @end table @@ -7985,6 +8557,10 @@ The return value is of type @code{INTEGER} and of the same kind as @node ISHFTC @section @code{ISHFTC} --- Shift bits circularly @fnindex ISHFTC +@fnindex BSHFTC +@fnindex IISHFTC +@fnindex JISHFTC +@fnindex KISHFTC @cindex bits, shift circular @table @asis @@ -7999,7 +8575,7 @@ a right shift. The absolute value of @var{SHIFT} must be less than equivalent to @code{BIT_SIZE(I)}. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -8020,6 +8596,16 @@ the value must be greater than zero and less than or equal to 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 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{ISHFTC(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later +@item @code{BSHFTC(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IISHFTC(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JISHFTC(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KISHFTC(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{ISHFT} @end table @@ -8076,11 +8662,16 @@ end program test_nan @table @asis @item @emph{Description}: -@code{IDATE(VALUES)} Fills @var{VALUES} with the numerical values at the +@code{ITIME(VALUES)} Fills @var{VALUES} with the numerical values at the current local time. The hour (in the range 1-24), minute (in the range 1-60), and seconds (in the range 1-60) appear in elements 1, 2, and 3 of @var{VALUES}, respectively. +This intrinsic routine is provided for backwards compatibility with +GNU Fortran 77. In new code, programmers should consider the use of +the @ref{DATE_AND_TIME} intrinsic defined by the Fortran 95 +standard. + @item @emph{Standard}: GNU extension @@ -8110,6 +8701,9 @@ program test_itime print *, tarray(3) end program test_itime @end smallexample + +@item @emph{See also}: +@ref{DATE_AND_TIME} @end table @@ -9061,10 +9655,15 @@ To stat an open file: @ref{FSTAT}, to stat a file: @ref{STAT} @table @asis @item @emph{Description}: -Given a system time value @var{TIME} (as provided by the @code{TIME8} +Given a system time value @var{TIME} (as provided by the @ref{TIME} intrinsic), fills @var{VALUES} with values extracted from it appropriate to the local time zone using @code{localtime(3)}. +This intrinsic routine is provided for backwards compatibility with +GNU Fortran 77. In new code, programmers should consider the use of +the @ref{DATE_AND_TIME} intrinsic defined by the Fortran 95 +standard. + @item @emph{Standard}: GNU extension @@ -9089,17 +9688,17 @@ The elements of @var{VALUES} are assigned as follows: seconds @item Minutes after the hour, range 0--59 @item Hours past midnight, range 0--23 -@item Day of month, range 0--31 -@item Number of months since January, range 0--12 +@item Day of month, range 1--31 +@item Number of months since January, range 0--11 @item Years since 1900 @item Number of days since Sunday, range 0--6 -@item Days since January 1 +@item Days since January 1, range 0--365 @item Daylight savings indicator: positive if daylight savings is in effect, zero if not, and negative if the information is not available. @end enumerate @item @emph{See also}: -@ref{CTIME}, @ref{GMTIME}, @ref{TIME}, @ref{TIME8} +@ref{DATE_AND_TIME}, @ref{CTIME}, @ref{GMTIME}, @ref{TIME}, @ref{TIME8} @end table @@ -9843,6 +10442,10 @@ cases, the result is of the same type and kind as @var{ARRAY}. @fnindex MOD @fnindex AMOD @fnindex DMOD +@fnindex BMOD +@fnindex IMOD +@fnindex JMOD +@fnindex KMOD @cindex remainder @cindex division, remainder @@ -9851,7 +10454,7 @@ cases, the result is of the same type and kind as @var{ARRAY}. @code{MOD(A,P)} computes the remainder of the division of A by P@. @item @emph{Standard}: -Fortran 77 and later +Fortran 77 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -9898,6 +10501,10 @@ end program test_mod @item @code{MOD(A,P)} @tab @code{INTEGER A,P} @tab @code{INTEGER} @tab Fortran 95 and later @item @code{AMOD(A,P)} @tab @code{REAL(4) A,P} @tab @code{REAL(4)} @tab Fortran 95 and later @item @code{DMOD(A,P)} @tab @code{REAL(8) A,P} @tab @code{REAL(8)} @tab Fortran 95 and later +@item @code{BMOD(A,P)} @tab @code{INTEGER(1) A,P} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IMOD(A,P)} @tab @code{INTEGER(2) A,P} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JMOD(A,P)} @tab @code{INTEGER(4) A,P} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KMOD(A,P)} @tab @code{INTEGER(8) A,P} @tab @code{INTEGER(8)} @tab GNU extension @end multitable @item @emph{See also}: @@ -10017,6 +10624,10 @@ end program test_move_alloc @node MVBITS @section @code{MVBITS} --- Move bits from one integer to another @fnindex MVBITS +@fnindex BMVBITS +@fnindex IMVBITS +@fnindex JMVBITS +@fnindex KMVBITS @cindex bits, move @table @asis @@ -10029,7 +10640,7 @@ affected by the movement of bits is unchanged. The values of @code{BIT_SIZE(FROM)}. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental subroutine @@ -10047,6 +10658,16 @@ same kind as @var{FROM}. @item @var{TOPOS} @tab The type shall be @code{INTEGER}. @end multitable +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item Name @tab Argument @tab Return type @tab Standard +@item @code{MVBITS(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later +@item @code{BMVBITS(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension +@item @code{IMVBITS(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JMVBITS(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KMVBITS(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{IBCLR}, @ref{IBSET}, @ref{IBITS}, @ref{IAND}, @ref{IOR}, @ref{IEOR} @end table @@ -10250,6 +10871,10 @@ END PROGRAM @node NOT @section @code{NOT} --- Logical negation @fnindex NOT +@fnindex BNOT +@fnindex INOT +@fnindex JNOT +@fnindex KNOT @cindex bits, negate @cindex bitwise logical not @cindex logical not, bitwise @@ -10259,7 +10884,7 @@ END PROGRAM @code{NOT} returns the bitwise Boolean inverse of @var{I}. @item @emph{Standard}: -Fortran 95 and later +Fortran 95 and later, has overloads that are GNU extensions @item @emph{Class}: Elemental function @@ -10276,6 +10901,16 @@ Elemental function The return type is @code{INTEGER}, of the same kind as the argument. +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@item @code{INOT(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension +@item @code{JNOT(A)} @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab GNU extension +@item @code{KNOT(A)} @tab @code{INTEGER(8) A} @tab @code{INTEGER(8)} @tab GNU extension +@end multitable + @item @emph{See also}: @ref{IAND}, @ref{IEOR}, @ref{IOR}, @ref{IBITS}, @ref{IBSET}, @ref{IBCLR} @@ -10957,23 +11592,16 @@ end program test_rand Returns a single pseudorandom number or an array of pseudorandom numbers from the uniform distribution over the range @math{ 0 \leq x < 1}. -The runtime-library implements George Marsaglia's KISS (Keep It Simple -Stupid) random number generator (RNG). This RNG combines: -@enumerate -@item The congruential generator @math{x(n) = 69069 \cdot x(n-1) + 1327217885} -with a period of @math{2^{32}}, -@item A 3-shift shift-register generator with a period of @math{2^{32} - 1}, -@item Two 16-bit multiply-with-carry generators with a period of -@math{597273182964842497 > 2^{59}}. -@end enumerate -The overall period exceeds @math{2^{123}}. +The runtime-library implements the xorshift1024* random number +generator (RNG). This generator has a period of @math{2^{1024} - 1}, +and when using multiple threads up to @math{2^{512}} threads can each +generate @math{2^{512}} random numbers before any aliasing occurs. + +Note that in a multi-threaded program (e.g. using OpenMP directives), +each thread will have its own random number state. For details of the +seeding procedure, see the documentation for the @code{RANDOM_SEED} +intrinsic. -Please note, this RNG is thread safe if used within OpenMP directives, -i.e., its state will be consistent while called from multiple threads. -However, the KISS generator does not create random numbers in parallel -from multiple sources, but in sequence from a single source. If an -OpenMP-enabled application heavily relies on random numbers, one should -consider employing a dedicated parallel random number generator instead. @item @emph{Standard}: Fortran 95 and later @@ -10993,7 +11621,6 @@ Subroutine @smallexample program test_random_number REAL :: r(5,5) - CALL init_random_seed() ! see example of RANDOM_SEED CALL RANDOM_NUMBER(r) end program @end smallexample @@ -11015,12 +11642,20 @@ end program Restarts or queries the state of the pseudorandom number generator used by @code{RANDOM_NUMBER}. -If @code{RANDOM_SEED} is called without arguments, it is initialized -to a default state. The example below shows how to initialize the -random seed with a varying seed in order to ensure a different random -number sequence for each invocation of the program. Note that setting -any of the seed values to zero should be avoided as it can result in -poor quality random numbers being generated. +If @code{RANDOM_SEED} is called without arguments, it is seeded with +random data retrieved from the operating system. + +As an extension to the Fortran standard, the GFortran +@code{RANDOM_NUMBER} supports multiple threads. Each thread in a +multi-threaded program has its own seed. When @code{RANDOM_SEED} is +called either without arguments or with the @var{PUT} argument, the +given seed is copied into a master seed as well as the seed of the +current thread. When a new thread uses @code{RANDOM_NUMBER} for the +first time, the seed is copied from the master seed, and forwarded +@math{N * 2^{512}} steps to guarantee that the random stream does not +alias any other stream in the system, where @var{N} is the number of +threads that have used @code{RANDOM_NUMBER} so far during the program +execution. @item @emph{Standard}: Fortran 95 and later @@ -11048,57 +11683,16 @@ the @var{SIZE} argument. @item @emph{Example}: @smallexample -subroutine init_random_seed() - use iso_fortran_env, only: int64 +program test_random_seed implicit none integer, allocatable :: seed(:) - integer :: i, n, un, istat, dt(8), pid - integer(int64) :: t + integer :: n call random_seed(size = n) allocate(seed(n)) - ! First try if the OS provides a random number generator - open(newunit=un, file="/dev/urandom", access="stream", & - form="unformatted", action="read", status="old", iostat=istat) - if (istat == 0) then - read(un) seed - close(un) - else - ! Fallback to XOR:ing the current time and pid. The PID is - ! useful in case one launches multiple instances of the same - ! program in parallel. - call system_clock(t) - if (t == 0) then - call date_and_time(values=dt) - t = (dt(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 & - + dt(2) * 31_int64 * 24 * 60 * 60 * 1000 & - + dt(3) * 24_int64 * 60 * 60 * 1000 & - + dt(5) * 60 * 60 * 1000 & - + dt(6) * 60 * 1000 + dt(7) * 1000 & - + dt(8) - end if - pid = getpid() - t = ieor(t, int(pid, kind(t))) - do i = 1, n - seed(i) = lcg(t) - end do - end if - call random_seed(put=seed) -contains - ! This simple PRNG might not be good enough for real work, but is - ! sufficient for seeding a better PRNG. - function lcg(s) - integer :: lcg - integer(int64) :: s - if (s == 0) then - s = 104729 - else - s = mod(s, 4294967296_int64) - end if - s = mod(s * 279470273_int64, 4294967291_int64) - lcg = int(mod(s, int(huge(0), int64)), kind(0)) - end function lcg -end subroutine init_random_seed + call random_seed(get=seed) + write (*, *) seed +end program test_random_seed @end smallexample @item @emph{See also}: @@ -11192,6 +11786,9 @@ end program test_rank @fnindex REALPART @fnindex FLOAT @fnindex DFLOAT +@fnindex FLOATI +@fnindex FLOATJ +@fnindex FLOATK @fnindex SNGL @cindex conversion, to real @cindex complex numbers, real part @@ -11252,6 +11849,9 @@ end program test_real @item Name @tab Argument @tab Return type @tab Standard @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 Fortran 77 and later @end multitable @@ -12256,7 +12856,69 @@ end program test_sin @end multitable @item @emph{See also}: -@ref{ASIN} +Inverse function: @ref{ASIN} +Degrees function: @ref{SIND} +@end table + + + +@node SIND +@section @code{SIND} --- Sine function, degrees +@fnindex SIND +@fnindex DSIND +@fnindex CSIND +@fnindex ZSIND +@fnindex CDSIND +@cindex trigonometric function, sine, degrees +@cindex sine, degrees + +@table @asis +@item @emph{Description}: +@code{SIND(X)} computes the sine of @var{X} in degrees. + +This function is for compatibility only and should be avoided in favor of +standard constructs wherever possible. + +@item @emph{Standard}: +GNU Extension, enabled with @option{-fdec-math}. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = SIND(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{X} @tab The type shall be @code{REAL} or +@code{COMPLEX}. +@end multitable + +@item @emph{Return value}: +The return value has same type and kind as @var{X}, and its value is in degrees. + +@item @emph{Example}: +@smallexample +program test_sind + real :: x = 0.0 + x = sind(x) +end program test_sind +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@item @code{CSIND(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab GNU Extension +@item @code{ZSIND(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU Extension +@item @code{CDSIND(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU Extension +@end multitable + +@item @emph{See also}: +Inverse function: @ref{ASIND} +Radians function: @ref{SIN} + @end table @@ -13017,7 +13679,7 @@ Elemental function @end multitable @item @emph{Return value}: -The return value has same type and kind as @var{X}. +The return value has same type and kind as @var{X}, and its value is in radians. @item @emph{Example}: @smallexample @@ -13035,7 +13697,61 @@ end program test_tan @end multitable @item @emph{See also}: -@ref{ATAN} +Inverse function: @ref{ATAN} +Degrees function: @ref{TAND} +@end table + + + +@node TAND +@section @code{TAND} --- Tangent function, degrees +@fnindex TAND +@fnindex DTAND +@cindex trigonometric function, tangent, degrees +@cindex tangent, degrees + +@table @asis +@item @emph{Description}: +@code{TAND(X)} computes the tangent of @var{X} in degrees. + +This function is for compatibility only and should be avoided in favor of +standard constructs wherever possible. + +@item @emph{Standard}: +GNU Extension, enabled with @option{-fdec-math}. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = TAND(X)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}. +@end multitable + +@item @emph{Return value}: +The return value has same type and kind as @var{X}, and its value is in degrees. + +@item @emph{Example}: +@smallexample +program test_tand + real(8) :: x = 0.165_8 + x = tand(x) +end program test_tand +@end smallexample + +@item @emph{Specific names}: +@multitable @columnfractions .20 .20 .20 .25 +@item 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 +@end multitable + +@item @emph{See also}: +Inverse function: @ref{ATAND} +Radians function: @ref{TAN} @end table @@ -13174,7 +13890,7 @@ IF (THIS_IMAGE(HUGE(1)) /= THIS_IMAGE()) @item @emph{Description}: Returns the current time encoded as an integer (in the manner of the function @code{time(3)} in the C standard library). This value is -suitable for passing to @code{CTIME}, @code{GMTIME}, and @code{LTIME}. +suitable for passing to @ref{CTIME}, @ref{GMTIME}, and @ref{LTIME}. This intrinsic is not fully portable, such as to systems with 32-bit @code{INTEGER} types but supporting times wider than 32 bits. Therefore, @@ -13199,7 +13915,7 @@ Function The return value is a scalar of type @code{INTEGER(4)}. @item @emph{See also}: -@ref{CTIME}, @ref{GMTIME}, @ref{LTIME}, @ref{MCLOCK}, @ref{TIME8} +@ref{DATE_AND_TIME}, @ref{CTIME}, @ref{GMTIME}, @ref{LTIME}, @ref{MCLOCK}, @ref{TIME8} @end table @@ -13215,7 +13931,7 @@ The return value is a scalar of type @code{INTEGER(4)}. @item @emph{Description}: Returns the current time encoded as an integer (in the manner of the function @code{time(3)} in the C standard library). This value is -suitable for passing to @code{CTIME}, @code{GMTIME}, and @code{LTIME}. +suitable for passing to @ref{CTIME}, @ref{GMTIME}, and @ref{LTIME}. @emph{Warning:} this intrinsic does not increase the range of the timing values over that returned by @code{time(3)}. On a system with a 32-bit @@ -13238,7 +13954,7 @@ Function The return value is a scalar of type @code{INTEGER(8)}. @item @emph{See also}: -@ref{CTIME}, @ref{GMTIME}, @ref{LTIME}, @ref{MCLOCK8}, @ref{TIME} +@ref{DATE_AND_TIME}, @ref{CTIME}, @ref{GMTIME}, @ref{LTIME}, @ref{MCLOCK8}, @ref{TIME} @end table @@ -14006,7 +14722,7 @@ Furthermore, if @code{__float128} is supported in C, the named constants @item @code{INTEGER}@tab @code{C_INT_FAST128_T} @tab @code{int_fast128_t} @tab Ext. @item @code{INTEGER}@tab @code{C_INTMAX_T} @tab @code{intmax_t} @item @code{INTEGER}@tab @code{C_INTPTR_T} @tab @code{intptr_t} -@item @code{INTEGER}@tab @code{C_PTRDIFF_T} @tab @code{intptr_t} @tab TS 29113 +@item @code{INTEGER}@tab @code{C_PTRDIFF_T} @tab @code{ptrdiff_t} @tab TS 29113 @item @code{REAL} @tab @code{C_FLOAT} @tab @code{float} @item @code{REAL} @tab @code{C_DOUBLE} @tab @code{double} @item @code{REAL} @tab @code{C_LONG_DOUBLE} @tab @code{long double} @@ -14078,7 +14794,7 @@ with the following options: @code{-fno-unsafe-math-optimizations @section OpenMP Modules @code{OMP_LIB} and @code{OMP_LIB_KINDS} @table @asis @item @emph{Standard}: -OpenMP Application Program Interface v4.0 +OpenMP Application Program Interface v4.5 @end table @@ -14092,8 +14808,8 @@ the named constants defined in the modules are listed below. For details refer to the actual -@uref{http://www.openmp.org/mp-documents/OpenMP4.0.0.pdf, -OpenMP Application Program Interface v4.0}. +@uref{http://www.openmp.org/wp-content/uploads/openmp-4.5.pdf, +OpenMP Application Program Interface v4.5}. @code{OMP_LIB_KINDS} provides the following scalar default-integer named constants: @@ -14108,7 +14824,7 @@ named constants: @code{OMP_LIB} provides the scalar default-integer named constant @code{openmp_version} with a value of the form @var{yyyymm}, where @code{yyyy} is the year and @var{mm} the month -of the OpenMP version; for OpenMP v4.0 the value is @code{201307}. +of the OpenMP version; for OpenMP v4.5 the value is @code{201511}. The following scalar integer named constants of the kind @code{omp_sched_kind}: diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index e8b8409319..636432fead 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -1,10 +1,10 @@ -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 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-2016 Free Software Foundation, Inc. +Copyright @copyright{} 2004-2017 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 @@ -116,13 +116,15 @@ by type. Explanations are in the following sections. @xref{Fortran Dialect Options,,Options controlling Fortran dialect}. @gccoptlist{-fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code @gol -fd-lines-as-comments @gol --fdec -fdec-structure -fdefault-double-8 -fdefault-integer-8 @gol +-fdec -fdec-structure -fdec-intrinsic-ints -fdec-static -fdec-math @gol +-fdefault-double-8 -fdefault-integer-8 @gol -fdefault-real-8 -fdollar-ok -ffixed-line-length-@var{n} @gol -ffixed-line-length-none -ffree-form -ffree-line-length-@var{n} @gol -ffree-line-length-none -fimplicit-none -finteger-4-integer-8 @gol -fmax-identifier-length -fmodule-private -ffixed-form -fno-range-check @gol -fopenacc -fopenmp -freal-4-real-10 -freal-4-real-16 -freal-4-real-8 @gol -freal-8-real-10 -freal-8-real-16 -freal-8-real-4 -std=@var{std} +-ftest-forall-temp } @item Preprocessing Options @@ -140,7 +142,7 @@ by type. Explanations are in the following sections. @item Error and Warning Options @xref{Error and Warning Options,,Options to request or suppress errors and warnings}. -@gccoptlist{-Waliasing -Wall -Wampersand -Warray-bounds +@gccoptlist{-Waliasing -Wall -Wampersand -Wargument-mismatch -Warray-bounds -Wc-binding-type -Wcharacter-truncation @gol -Wconversion -Wfunction-elimination -Wimplicit-interface @gol -Wimplicit-procedure -Wintrinsic-shadow -Wuse-without-only -Wintrinsics-std @gol @@ -177,6 +179,7 @@ and warnings}. -fcoarray=@var{<none|single|lib>} -fexternal-blas -ff2c -ffrontend-optimize @gol -finit-character=@var{n} -finit-integer=@var{n} -finit-local-zero @gol +-finit-derived @gol -finit-logical=@var{<true|false>} -finit-real=@var{<zero|inf|-inf|nan|snan>} @gol -finline-matmul-limit=@var{n} @gol @@ -234,11 +237,15 @@ comment lines. DEC compatibility mode. Enables extensions and other features that mimic the default behavior of older compilers (such as DEC). These features are non-standard and should be avoided at all costs. -For details on GNU Fortran's implementation of these extensions see the +For details on GNU Fortran's implementation of these extensions see the full documentation. Other flags enabled by this switch are: @option{-fdollar-ok} @option{-fcray-pointer} @option{-fdec-structure} +@option{-fdec-intrinsic-ints} @option{-fdec-static} @option{-fdec-math} + +If @option{-fd-lines-as-code}/@option{-fd-lines-as-comments} are unset, then +@option{-fdec} also sets @option{-fd-lines-as-comments}. @item -fdec-structure @opindex @code{fdec-structure} @@ -247,6 +254,21 @@ Enable DEC @code{STRUCTURE} and @code{RECORD} as well as @code{UNION}, provided for compatibility only; Fortran 90 derived types should be used instead where possible. +@item -fdec-intrinsic-ints +@opindex @code{fdec-intrinsic-ints} +Enable B/I/J/K kind variants of existing integer functions (e.g. BIAND, IIAND, +JIAND, etc...). For a complete list of intrinsics see the full documentation. + +@item -fdec-math +@opindex @code{fdec-math} +Enable legacy math intrinsics such as COTAN and degree-valued trigonometric +functions (e.g. TAND, ATAND, etc...) for compatability with older code. + +@item -fdec-static +@opindex @code{fdec-static} +Enable DEC-style STATIC and AUTOMATIC attributes to explicitly specify +the storage of variables and other objects. + @item -fdollar-ok @opindex @code{fdollar-ok} @cindex @code{$} @@ -438,6 +460,10 @@ allows the Fortran 2008 standard including the additions of the Technical Specification (TS) 29113 on Further Interoperability of Fortran with C and TS 18508 on Additional Parallel Features in Fortran. +@item -ftest-forall-temp +@opindex @code{ftest-forall-temp} +Enhance test coverage by forcing most forall assignments to use temporary. + @end table @node Preprocessing Options @@ -728,8 +754,10 @@ Check the code for syntax errors, but do not actually compile it. This will generate module files for each module present in the code, but no other output file. -@item -pedantic +@item -Wpedantic +@itemx -pedantic @opindex @code{pedantic} +@opindex @code{Wpedantic} Issue warnings for uses of extensions to Fortran 95. @option{-pedantic} also applies to C-language constructs where they occur in GNU Fortran source files, such as use of @samp{\e} in a @@ -764,7 +792,8 @@ This currently includes @option{-Waliasing}, @option{-Wampersand}, @option{-Wconversion}, @option{-Wsurprising}, @option{-Wc-binding-type}, @option{-Wintrinsics-std}, @option{-Wtabs}, @option{-Wintrinsic-shadow}, @option{-Wline-truncation}, @option{-Wtarget-lifetime}, -@option{-Winteger-division}, @option{-Wreal-q-constant} and @option{-Wunused}. +@option{-Winteger-division}, @option{-Wreal-q-constant}, @option{-Wunused} +and @option{-Wundefined-do-loop}. @item -Waliasing @opindex @code{Waliasing} @@ -799,6 +828,15 @@ given in a continued character constant, GNU Fortran assumes continuation at the first non-comment, non-whitespace character after the ampersand that initiated the continuation. +@item -Wargument-mismatch +@opindex @code{Wargument-mismatch} +@cindex warnings, argument mismatch +@cindex warnings, parameter mismatch +@cindex warnings, interface mismatch +Warn about type, rank, and other mismatches between formal parameters and actual +arguments to functions and subroutines. These warnings are recommended and +thus enabled by default. + @item -Warray-temporaries @opindex @code{Warray-temporaries} @cindex warnings, array temporaries @@ -924,6 +962,13 @@ a warning to be issued if a tab is encountered. Note, @option{-Wtabs} is active for @option{-pedantic}, @option{-std=f95}, @option{-std=f2003}, @option{-std=f2008}, @option{-std=f2008ts} and @option{-Wall}. +@item -Wundefined-do-loop +@opindex @code{Wundefined-do-loop} +@cindex warnings, undefined do loop +Warn if a DO loop with step either 1 or -1 yields an underflow or an overflow +during iteration of an induction variable of the loop. +This option is implied by @option{-Wall}. + @item -Wunderflow @opindex @code{Wunderflow} @cindex warnings, underflow @@ -1584,9 +1629,8 @@ for matrices with size up to @var{n}. If the matrices involved are not square, the size comparison is performed using the geometric mean of the dimensions of the argument and result matrices. -The default value for @var{n} is the value specified for -@code{-fblas-matmul-limit} if this option is specified, or unlimitited -otherwise. +The default value for @var{n} is 30. The @code{-fblas-matmul-limit} +can be used to change this value. @item -frecursive @opindex @code{frecursive} @@ -1595,11 +1639,13 @@ on the stack. This flag cannot be used together with @option{-fmax-stack-var-size=} or @option{-fno-automatic}. @item -finit-local-zero +@itemx -finit-derived @itemx -finit-integer=@var{n} @itemx -finit-real=@var{<zero|inf|-inf|nan|snan>} @itemx -finit-logical=@var{<true|false>} @itemx -finit-character=@var{n} @opindex @code{finit-local-zero} +@opindex @code{finit-derived} @opindex @code{finit-integer} @opindex @code{finit-real} @opindex @code{finit-logical} @@ -1614,13 +1660,13 @@ initialization options are provided by the the real and imaginary parts of local @code{COMPLEX} variables), @option{-finit-logical=@var{<true|false>}}, and @option{-finit-character=@var{n}} (where @var{n} is an ASCII character -value) options. These options do not initialize +value) options. Components of derived type variables will be initialized +according to these flags only with @option{-finit-derived}. These options do +not initialize @itemize @bullet @item allocatable arrays @item -components of derived type variables -@item variables that appear in an @code{EQUIVALENCE} statement. @end itemize (These limitations may be removed in future releases). diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 6a4515d3c1..60df44dc69 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1,5 +1,5 @@ /* Deal with I/O statements & related stuff. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -38,6 +38,15 @@ typedef struct io_tag; static const io_tag + tag_readonly = {"READONLY", " readonly", NULL, BT_UNKNOWN }, + tag_shared = {"SHARE", " shared", NULL, BT_UNKNOWN }, + tag_noshared = {"SHARE", " noshared", NULL, BT_UNKNOWN }, + tag_e_share = {"SHARE", " share =", " %e", BT_CHARACTER }, + tag_v_share = {"SHARE", " share =", " %v", BT_CHARACTER }, + tag_cc = {"CARRIAGECONTROL", " carriagecontrol =", " %e", + BT_CHARACTER }, + tag_v_cc = {"CARRIAGECONTROL", " carriagecontrol =", " %v", + BT_CHARACTER }, tag_file = {"FILE", " file =", " %e", BT_CHARACTER }, tag_status = {"STATUS", " status =", " %e", BT_CHARACTER}, tag_e_access = {"ACCESS", " access =", " %e", BT_CHARACTER}, @@ -113,7 +122,7 @@ enum format_token FMT_RPAREN, FMT_X, FMT_SIGN, FMT_BLANK, FMT_CHAR, FMT_P, FMT_IBOZ, FMT_F, FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_ERROR, FMT_DC, FMT_DP, FMT_T, FMT_TR, FMT_TL, FMT_STAR, FMT_RC, - FMT_RD, FMT_RN, FMT_RP, FMT_RU, FMT_RZ + FMT_RD, FMT_RN, FMT_RP, FMT_RU, FMT_RZ, FMT_DT }; /* Local variables for checking format strings. The saved_token is @@ -191,23 +200,14 @@ unget_char (void) /* Eat up the spaces and return a character. */ static char -next_char_not_space (bool *error) +next_char_not_space () { char c; do { error_element = c = next_char (NONSTRING); if (c == '\t') - { - if (gfc_option.allow_std & GFC_STD_GNU) - gfc_warning (0, "Extension: Tab character in format at %C"); - else - { - gfc_error ("Extension: Tab character in format at %C"); - *error = true; - return c; - } - } + gfc_warning (OPT_Wtabs, "Nonconforming tab character in format at %C"); } while (gfc_is_whitespace (c)); return c; @@ -225,7 +225,6 @@ format_lex (void) char c, delim; int zflag; int negative_flag; - bool error = false; if (saved_token != FMT_NONE) { @@ -234,7 +233,7 @@ format_lex (void) return token; } - c = next_char_not_space (&error); + c = next_char_not_space (); negative_flag = 0; switch (c) @@ -244,7 +243,7 @@ format_lex (void) /* Falls through. */ case '+': - c = next_char_not_space (&error); + c = next_char_not_space (); if (!ISDIGIT (c)) { token = FMT_UNKNOWN; @@ -255,7 +254,7 @@ format_lex (void) do { - c = next_char_not_space (&error); + c = next_char_not_space (); if (ISDIGIT (c)) value = 10 * value + c - '0'; } @@ -285,7 +284,7 @@ format_lex (void) do { - c = next_char_not_space (&error); + c = next_char_not_space (); if (ISDIGIT (c)) { value = 10 * value + c - '0'; @@ -320,7 +319,7 @@ format_lex (void) break; case 'T': - c = next_char_not_space (&error); + c = next_char_not_space (); switch (c) { case 'L': @@ -348,7 +347,7 @@ format_lex (void) break; case 'S': - c = next_char_not_space (&error); + c = next_char_not_space (); if (c != 'P' && c != 'S') unget_char (); @@ -356,7 +355,7 @@ format_lex (void) break; case 'B': - c = next_char_not_space (&error); + c = next_char_not_space (); if (c == 'N' || c == 'Z') token = FMT_BLANK; else @@ -418,7 +417,7 @@ format_lex (void) break; case 'E': - c = next_char_not_space (&error); + c = next_char_not_space (); if (c == 'N' ) token = FMT_EN; else if (c == 'S') @@ -448,7 +447,7 @@ format_lex (void) break; case 'D': - c = next_char_not_space (&error); + c = next_char_not_space (); if (c == 'P') { if (!gfc_notify_std (GFC_STD_F2003, "DP format " @@ -463,6 +462,45 @@ format_lex (void) return FMT_ERROR; token = FMT_DC; } + else if (c == 'T') + { + if (!gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DT format " + "specifier not allowed at %C")) + return FMT_ERROR; + token = FMT_DT; + c = next_char_not_space (); + if (c == '\'' || c == '"') + { + delim = c; + value = 0; + + for (;;) + { + c = next_char (INSTRING_WARN); + if (c == '\0') + { + token = FMT_END; + break; + } + + if (c == delim) + { + c = next_char (NONSTRING); + if (c == '\0') + { + token = FMT_END; + break; + } + if (c == delim) + continue; + unget_char (); + break; + } + } + } + else + unget_char (); + } else { token = FMT_D; @@ -471,7 +509,7 @@ format_lex (void) break; case 'R': - c = next_char_not_space (&error); + c = next_char_not_space (); switch (c) { case 'C': @@ -512,9 +550,6 @@ format_lex (void) break; } - if (error) - return FMT_ERROR; - return token; } @@ -554,7 +589,7 @@ check_format (bool is_input) const char *unexpected_end = _("Unexpected end of format string"); const char *zero_width = _("Zero width in format descriptor"); - const char *error; + const char *error = NULL; format_token t, u; int level; int repeat; @@ -652,6 +687,54 @@ format_item_1: return false; goto between_desc; + case FMT_DT: + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + switch (t) + { + case FMT_RPAREN: + level--; + if (level < 0) + goto finished; + goto between_desc; + + case FMT_COMMA: + goto format_item; + + case FMT_LPAREN: + + dtio_vlist: + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + + if (t != FMT_POSINT) + { + error = posint_required; + goto syntax; + } + + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + + if (t == FMT_COMMA) + goto dtio_vlist; + if (t != FMT_RPAREN) + { + error = _("Right parenthesis expected at %C"); + goto syntax; + } + goto between_desc; + + default: + error = unexpected_element; + goto syntax; + } + + goto format_item; + case FMT_SIGN: case FMT_BLANK: case FMT_DP: @@ -772,27 +855,31 @@ data_desc: goto fail; if (t == FMT_POSINT) break; - - switch (gfc_notification_std (GFC_STD_GNU)) + if (mode != MODE_FORMAT) + format_locus.nextc += format_string_pos; + if (t == FMT_ZERO) { - case WARNING: - if (mode != MODE_FORMAT) - format_locus.nextc += format_string_pos; - gfc_warning (0, "Extension: Missing positive width after L " - "descriptor at %L", &format_locus); - saved_token = t; - break; - - case ERROR: - error = posint_required; - goto syntax; - - case SILENT: - saved_token = t; - break; - - default: - gcc_unreachable (); + switch (gfc_notification_std (GFC_STD_GNU)) + { + case WARNING: + gfc_warning (0, "Extension: Zero width after L " + "descriptor at %L", &format_locus); + break; + case ERROR: + gfc_error ("Extension: Zero width after L " + "descriptor at %L", &format_locus); + goto fail; + case SILENT: + break; + default: + gcc_unreachable (); + } + } + else + { + saved_token = t; + gfc_notify_std (GFC_STD_GNU, "Missing positive width after " + "L descriptor at %L", &format_locus); } break; @@ -1409,6 +1496,97 @@ match_ltag (const io_tag *tag, gfc_st_label ** label) } +/* Match a tag using match_etag, but only if -fdec is enabled. */ +static match +match_dec_etag (const io_tag *tag, gfc_expr **e) +{ + match m = match_etag (tag, e); + if (flag_dec && m != MATCH_NO) + return m; + else if (m != MATCH_NO) + { + gfc_error ("%s is a DEC extension at %C, re-compile with " + "-fdec to enable", tag->name); + return MATCH_ERROR; + } + return m; +} + + +/* Match a tag using match_vtag, but only if -fdec is enabled. */ +static match +match_dec_vtag (const io_tag *tag, gfc_expr **e) +{ + match m = match_vtag(tag, e); + if (flag_dec && m != MATCH_NO) + return m; + else if (m != MATCH_NO) + { + gfc_error ("%s is a DEC extension at %C, re-compile with " + "-fdec to enable", tag->name); + return MATCH_ERROR; + } + return m; +} + + +/* Match a DEC I/O flag tag - a tag with no expression such as READONLY. */ + +static match +match_dec_ftag (const io_tag *tag, gfc_open *o) +{ + match m; + + m = gfc_match (tag->spec); + if (m != MATCH_YES) + return m; + + if (!flag_dec) + { + gfc_error ("%s is a DEC extension at %C, re-compile with " + "-fdec to enable", tag->name); + return MATCH_ERROR; + } + + /* Just set the READONLY flag, which we use at runtime to avoid delete on + close. */ + if (tag == &tag_readonly) + { + o->readonly |= 1; + return MATCH_YES; + } + + /* Interpret SHARED as SHARE='DENYNONE' (read lock). */ + else if (tag == &tag_shared) + { + if (o->share != NULL) + { + gfc_error ("Duplicate %s specification at %C", tag->name); + return MATCH_ERROR; + } + o->share = gfc_get_character_expr (gfc_default_character_kind, + &gfc_current_locus, "denynone", 8); + return MATCH_YES; + } + + /* Interpret NOSHARED as SHARE='DENYRW' (exclusive lock). */ + else if (tag == &tag_noshared) + { + if (o->share != NULL) + { + gfc_error ("Duplicate %s specification at %C", tag->name); + return MATCH_ERROR; + } + o->share = gfc_get_character_expr (gfc_default_character_kind, + &gfc_current_locus, "denyrw", 6); + return MATCH_YES; + } + + /* We handle all DEC tags above. */ + gcc_unreachable (); +} + + /* Resolution of the FORMAT tag, to be called from resolve_tag. */ static bool @@ -1657,6 +1835,23 @@ match_open_element (gfc_open *open) if (m != MATCH_NO) return m; + /* The following are extensions enabled with -fdec. */ + m = match_dec_etag (&tag_e_share, &open->share); + if (m != MATCH_NO) + return m; + m = match_dec_etag (&tag_cc, &open->cc); + if (m != MATCH_NO) + return m; + m = match_dec_ftag (&tag_readonly, open); + if (m != MATCH_NO) + return m; + m = match_dec_ftag (&tag_shared, open); + if (m != MATCH_NO) + return m; + m = match_dec_ftag (&tag_noshared, open); + if (m != MATCH_NO) + return m; + return MATCH_NO; } @@ -1689,6 +1884,8 @@ gfc_free_open (gfc_open *open) gfc_free_expr (open->convert); gfc_free_expr (open->asynchronous); gfc_free_expr (open->newunit); + gfc_free_expr (open->share); + gfc_free_expr (open->cc); free (open); } @@ -1719,6 +1916,8 @@ gfc_resolve_open (gfc_open *open) RESOLVE_TAG (&tag_e_sign, open->sign); RESOLVE_TAG (&tag_convert, open->convert); RESOLVE_TAG (&tag_newunit, open->newunit); + RESOLVE_TAG (&tag_e_share, open->share); + RESOLVE_TAG (&tag_cc, open->cc); if (!gfc_reference_st_label (open->err, ST_LABEL_TARGET)) return false; @@ -1928,15 +2127,29 @@ gfc_match_open (void) /* Checks on the ACTION specifier. */ if (open->action && open->action->expr_type == EXPR_CONSTANT) { + gfc_char_t *str = open->action->value.character.string; static const char *action[] = { "READ", "WRITE", "READWRITE", NULL }; if (!is_char_type ("ACTION", open->action)) goto cleanup; if (!compare_to_allowed_values ("ACTION", action, NULL, NULL, - open->action->value.character.string, - "OPEN", warn)) + str, "OPEN", warn)) goto cleanup; + + /* With READONLY, only allow ACTION='READ'. */ + if (open->readonly && (gfc_wide_strlen (str) != 4 + || gfc_wide_strncasecmp (str, "READ", 4) != 0)) + { + gfc_error ("ACTION type conflicts with READONLY specifier at %C"); + goto cleanup; + } + } + /* If we see READONLY and no ACTION, set ACTION='READ'. */ + else if (open->readonly && open->action == NULL) + { + open->action = gfc_get_character_expr (gfc_default_character_kind, + &gfc_current_locus, "read", 4); } /* Checks on the ASYNCHRONOUS specifier. */ @@ -1981,6 +2194,22 @@ gfc_match_open (void) } } + /* Checks on the CARRIAGECONTROL specifier. */ + if (open->cc) + { + if (!is_char_type ("CARRIAGECONTROL", open->cc)) + goto cleanup; + + if (open->cc->expr_type == EXPR_CONSTANT) + { + static const char *cc[] = { "LIST", "FORTRAN", "NONE", NULL }; + if (!compare_to_allowed_values ("CARRIAGECONTROL", cc, NULL, NULL, + open->cc->value.character.string, + "OPEN", warn)) + goto cleanup; + } + } + /* Checks on the DECIMAL specifier. */ if (open->decimal) { @@ -2105,6 +2334,22 @@ gfc_match_open (void) } } + /* Checks on the SHARE specifier. */ + if (open->share) + { + if (!is_char_type ("SHARE", open->share)) + goto cleanup; + + if (open->share->expr_type == EXPR_CONSTANT) + { + static const char *share[] = { "DENYNONE", "DENYRW", NULL }; + if (!compare_to_allowed_values ("SHARE", share, NULL, NULL, + open->share->value.character.string, + "OPEN", warn)) + goto cleanup; + } + } + /* Checks on the SIGN specifier. */ if (open->sign) { @@ -2602,6 +2847,7 @@ static match match_dt_unit (io_kind k, gfc_dt *dt) { gfc_expr *e; + char c; if (gfc_match_char ('*') == MATCH_YES) { @@ -2609,6 +2855,11 @@ match_dt_unit (io_kind k, gfc_dt *dt) goto conflict; dt->io_unit = default_unit (k); + + c = gfc_peek_ascii_char (); + if (c == ')') + gfc_error_now ("Missing format with default unit at %C"); + return MATCH_YES; } @@ -3052,7 +3303,7 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc) && dt->format_label->defined == ST_LABEL_UNKNOWN) { gfc_error ("FORMAT label %d at %L not defined", dt->format_label->value, - &dt->format_label->where); + loc); return false; } @@ -3586,7 +3837,7 @@ if (condition) \ io_constraint (unformatted && dt->namelist == NULL, "DELIM= specifier at %L must be with FMT=* or " - "NML= specifier ", &dt->delim->where); + "NML= specifier", &dt->delim->where); } } @@ -3689,7 +3940,7 @@ match_io (io_kind k) gfc_symbol *sym; int comma_flag; locus where; - locus spec_end; + locus spec_end, control; gfc_dt *dt; match m; @@ -3751,21 +4002,59 @@ match_io (io_kind k) { /* Before issuing an error for a malformed 'print (1,*)' type of error, check for a default-char-expr of the form ('(I0)'). */ - if (k == M_PRINT && m == MATCH_YES) - { - /* Reset current locus to get the initial '(' in an expression. */ - gfc_current_locus = where; - dt->format_expr = NULL; - m = match_dt_format (dt); + if (m == MATCH_YES) + { + control = gfc_current_locus; + if (k == M_PRINT) + { + /* Reset current locus to get the initial '(' in an expression. */ + gfc_current_locus = where; + dt->format_expr = NULL; + m = match_dt_format (dt); - if (m == MATCH_ERROR) - goto cleanup; - if (m == MATCH_NO || dt->format_expr == NULL) - goto syntax; + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO || dt->format_expr == NULL) + goto syntax; - comma_flag = 1; - dt->io_unit = default_unit (k); - goto get_io_list; + comma_flag = 1; + dt->io_unit = default_unit (k); + goto get_io_list; + } + if (k == M_READ) + { + /* Commit any pending symbols now so that when we undo + symbols later we wont lose them. */ + gfc_commit_symbols (); + /* Reset current locus to get the initial '(' in an expression. */ + gfc_current_locus = where; + dt->format_expr = NULL; + m = gfc_match_expr (&dt->format_expr); + if (m == MATCH_YES) + { + if (dt->format_expr + && dt->format_expr->ts.type == BT_CHARACTER) + { + comma_flag = 1; + dt->io_unit = default_unit (k); + goto get_io_list; + } + else + { + gfc_free_expr (dt->format_expr); + dt->format_expr = NULL; + gfc_current_locus = control; + } + } + else + { + gfc_clear_error (); + gfc_undo_symbols (); + gfc_free_expr (dt->format_expr); + dt->format_expr = NULL; + gfc_current_locus = control; + } + } } } @@ -3866,6 +4155,10 @@ get_io_list: goto syntax; } + /* See if we want to use defaults for missing exponents in real transfers. */ + if (flag_dec) + dt->default_exp = 1; + /* A full IO statement has been matched. Check the constraints. spec_end is supplied for cases where no locus is supplied. */ m = check_io_constraints (k, dt, io_code, &spec_end); @@ -3972,6 +4265,8 @@ gfc_free_inquire (gfc_inquire *inquire) gfc_free_expr (inquire->sign); gfc_free_expr (inquire->size); gfc_free_expr (inquire->round); + gfc_free_expr (inquire->share); + gfc_free_expr (inquire->cc); free (inquire); } @@ -4027,6 +4322,8 @@ match_inquire_element (gfc_inquire *inquire) RETM m = match_vtag (&tag_pending, &inquire->pending); RETM m = match_vtag (&tag_id, &inquire->id); RETM m = match_vtag (&tag_s_iqstream, &inquire->iqstream); + RETM m = match_dec_vtag (&tag_v_share, &inquire->share); + RETM m = match_dec_vtag (&tag_v_cc, &inquire->cc); RETM return MATCH_NO; } @@ -4132,9 +4429,11 @@ gfc_match_inquire (void) if (inquire->unit != NULL && inquire->unit->expr_type == EXPR_CONSTANT && inquire->unit->ts.type == BT_INTEGER - && mpz_get_si (inquire->unit->value.integer) == GFC_INTERNAL_UNIT) + && ((mpz_get_si (inquire->unit->value.integer) == GFC_INTERNAL_UNIT4) + || (mpz_get_si (inquire->unit->value.integer) == GFC_INTERNAL_UNIT))) { - gfc_error ("UNIT number in INQUIRE statement at %L can not be -1", &loc); + gfc_error ("UNIT number in INQUIRE statement at %L can not " + "be %d", &loc, (int) mpz_get_si (inquire->unit->value.integer)); goto cleanup; } @@ -4222,6 +4521,8 @@ gfc_resolve_inquire (gfc_inquire *inquire) INQUIRE_RESOLVE_TAG (&tag_size, inquire->size); INQUIRE_RESOLVE_TAG (&tag_s_decimal, inquire->decimal); INQUIRE_RESOLVE_TAG (&tag_s_iqstream, inquire->iqstream); + INQUIRE_RESOLVE_TAG (&tag_v_share, inquire->share); + INQUIRE_RESOLVE_TAG (&tag_v_cc, inquire->cc); #undef INQUIRE_RESOLVE_TAG if (!gfc_reference_st_label (inquire->err, ST_LABEL_TARGET)) diff --git a/gcc/fortran/ioparm.def b/gcc/fortran/ioparm.def index e448a92127..9789dd164a 100644 --- a/gcc/fortran/ioparm.def +++ b/gcc/fortran/ioparm.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2005-2016 Free Software Foundation, Inc. +/* Copyright (C) 2005-2017 Free Software Foundation, Inc. This file is part of GCC. @@ -16,6 +16,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/>. */ +/* Make sure to keep in sync with libgfortran/io/io.h (st_parameter_*). */ #ifndef IOPARM_common_libreturn_mask #define IOPARM_common_libreturn_mask 3 #define IOPARM_common_libreturn_ok 0 @@ -50,6 +51,9 @@ IOPARM (open, round, 1 << 20, char2) IOPARM (open, sign, 1 << 21, char1) IOPARM (open, asynchronous, 1 << 22, char2) IOPARM (open, newunit, 1 << 23, pint4) +IOPARM (open, readonly, 1 << 24, int4) +IOPARM (open, cc, 1 << 25, char2) +IOPARM (open, share, 1 << 26, char1) IOPARM (close, common, 0, common) IOPARM (close, status, 1 << 7, char1) IOPARM (filepos, common, 0, common) @@ -88,13 +92,13 @@ IOPARM (inquire, pending, 1 << 5, pint4) IOPARM (inquire, size, 1 << 6, pintio) IOPARM (inquire, id, 1 << 7, pint4) IOPARM (inquire, iqstream, 1 << 8, char1) +IOPARM (inquire, share, 1 << 9, char2) +IOPARM (inquire, cc, 1 << 10, char1) IOPARM (wait, common, 0, common) IOPARM (wait, id, 1 << 7, pint4) -#ifndef IOPARM_dt_list_format +IOPARM (dt, common, 0, common) #define IOPARM_dt_list_format (1 << 7) #define IOPARM_dt_namelist_read_mode (1 << 8) -#endif -IOPARM (dt, common, 0, common) IOPARM (dt, rec, 1 << 9, intio) IOPARM (dt, size, 1 << 10, pintio) IOPARM (dt, iolength, 1 << 11, pintio) @@ -103,7 +107,6 @@ IOPARM (dt, format, 1 << 12, char1) IOPARM (dt, advance, 1 << 13, char2) IOPARM (dt, internal_unit, 1 << 14, char1) IOPARM (dt, namelist_name, 1 << 15, char2) -IOPARM (dt, u, 0, pad) IOPARM (dt, id, 1 << 16, pint4) IOPARM (dt, pos, 1 << 17, intio) IOPARM (dt, asynchronous, 1 << 18, char1) @@ -113,3 +116,7 @@ IOPARM (dt, delim, 1 << 21, char2) IOPARM (dt, pad, 1 << 22, char1) IOPARM (dt, round, 1 << 23, char2) IOPARM (dt, sign, 1 << 24, char1) +#define IOPARM_dt_f2003 (1 << 25) +#define IOPARM_dt_dtio (1 << 26) +#define IOPARM_dt_default_exp (1 << 27) +IOPARM (dt, u, 0, pad) diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index ecea1c3a71..b784ac339e 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -1,5 +1,5 @@ /* Intrinsic function resolution. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -47,15 +47,27 @@ const char * gfc_get_string (const char *format, ...) { char temp_name[128]; + const char *str; va_list ap; tree ident; - va_start (ap, format); - vsnprintf (temp_name, sizeof (temp_name), format, ap); - va_end (ap); - temp_name[sizeof (temp_name) - 1] = 0; + /* Handle common case without vsnprintf and temporary buffer. */ + if (format[0] == '%' && format[1] == 's' && format[2] == '\0') + { + va_start (ap, format); + str = va_arg (ap, const char *); + va_end (ap); + } + else + { + va_start (ap, format); + vsnprintf (temp_name, sizeof (temp_name), format, ap); + va_end (ap); + temp_name[sizeof (temp_name) - 1] = 0; + str = temp_name; + } - ident = get_identifier (temp_name); + ident = get_identifier (str); return IDENTIFIER_POINTER (ident); } @@ -141,7 +153,7 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind, } } - f->value.function.name = gfc_get_string (name); + f->value.function.name = gfc_get_string ("%s", name); } @@ -174,7 +186,7 @@ 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), array->ts.kind); } @@ -229,7 +241,7 @@ gfc_resolve_adjustr (gfc_expr *f, gfc_expr *string) static void gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind, - const char *name) + bool is_achar) { f->ts.type = BT_CHARACTER; f->ts.kind = (kind == NULL) @@ -237,16 +249,16 @@ gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind, f->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); f->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1); - f->value.function.name = gfc_get_string (name, f->ts.kind, - gfc_type_letter (x->ts.type), - x->ts.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); } void gfc_resolve_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind) { - gfc_resolve_char_achar (f, x, kind, "__achar_%d_%c%d"); + gfc_resolve_char_achar (f, x, kind, true); } @@ -536,7 +548,7 @@ gfc_resolve_ceiling (gfc_expr *f, gfc_expr *a, gfc_expr *kind) void gfc_resolve_char (gfc_expr *f, gfc_expr *a, gfc_expr *kind) { - gfc_resolve_char_achar (f, a, kind, "__char_%d_%c%d"); + gfc_resolve_char_achar (f, a, kind, false); } @@ -673,6 +685,86 @@ gfc_resolve_cosh (gfc_expr *f, gfc_expr *x) } +/* Our replacement of elements of a trig call with an EXPR_OP (e.g. + multiplying the result or operands by a factor to convert to/from degrees) + will cause the resolve_* function to be invoked again when resolving the + freshly created EXPR_OP. See gfc_resolve_trigd, gfc_resolve_atrigd, + gfc_resolve_cotan. We must observe this and avoid recursively creating + layers of nested EXPR_OP expressions. */ + +static bool +is_trig_resolved (gfc_expr *f) +{ + /* We know we've already resolved the function if we see the lib call + starting with '__'. */ + return (f->value.function.name != NULL + && strncmp ("__", f->value.function.name, 2) == 0); +} + +/* Return a shallow copy of the function expression f. The original expression + has its pointers cleared so that it may be freed without affecting the + shallow copy. This is similar to gfc_copy_expr, but doesn't perform a deep + copy of the argument list, allowing it to be reused somewhere else, + setting the expression up nicely for gfc_replace_expr. */ + +static gfc_expr * +copy_replace_function_shallow (gfc_expr *f) +{ + gfc_expr *fcopy; + gfc_actual_arglist *args; + + /* The only thing deep-copied in gfc_copy_expr is args. */ + args = f->value.function.actual; + f->value.function.actual = NULL; + fcopy = gfc_copy_expr (f); + fcopy->value.function.actual = args; + + /* Clear the old function so the shallow copy is not affected if the old + expression is freed. */ + f->value.function.name = NULL; + f->value.function.isym = NULL; + f->value.function.actual = NULL; + f->value.function.esym = NULL; + f->shape = NULL; + f->ref = NULL; + + return fcopy; +} + + +/* Resolve cotan = cos / sin. */ + +void +gfc_resolve_cotan (gfc_expr *f, gfc_expr *x) +{ + gfc_expr *result, *fcopy, *sin; + gfc_actual_arglist *sin_args; + + if (is_trig_resolved (f)) + return; + + /* Compute cotan (x) = cos (x) / sin (x). */ + f->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_COS); + gfc_resolve_cos (f, x); + + sin_args = gfc_get_actual_arglist (); + sin_args->expr = gfc_copy_expr (x); + + sin = gfc_get_expr (); + sin->ts = f->ts; + sin->where = f->where; + sin->expr_type = EXPR_FUNCTION; + sin->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_SIN); + sin->value.function.actual = sin_args; + gfc_resolve_sin (sin, sin_args->expr); + + /* Replace f with cos/sin - we do this in place in f for the caller. */ + fcopy = copy_replace_function_shallow (f); + result = gfc_divide (fcopy, sin); + gfc_replace_expr (f, result); +} + + void gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim, gfc_expr *kind) { @@ -964,15 +1056,19 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo) gfc_add_vptr_component (a); else if (a->ts.type == BT_DERIVED) { + locus where; + vtab = gfc_find_derived_vtab (a->ts.u.derived); /* Clear the old expr. */ gfc_free_ref_list (a->ref); + where = a->where; memset (a, '\0', sizeof (gfc_expr)); /* Construct a new one. */ a->expr_type = EXPR_VARIABLE; st = gfc_find_symtree (vtab->ns->sym_root, vtab->name); a->symtree = st; a->ts = vtab->ts; + a->where = where; } /* Replace the second argument with the corresponding vtab. */ @@ -980,8 +1076,11 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo) gfc_add_vptr_component (mo); else if (mo->ts.type == BT_DERIVED) { + locus where; + vtab = gfc_find_derived_vtab (mo->ts.u.derived); /* Clear the old expr. */ + where = mo->where; gfc_free_ref_list (mo->ref); memset (mo, '\0', sizeof (gfc_expr)); /* Construct a new one. */ @@ -989,6 +1088,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo) st = gfc_find_symtree (vtab->ns->sym_root, vtab->name); mo->symtree = st; mo->ts = vtab->ts; + mo->where = where; } f->ts.type = BT_LOGICAL; @@ -2516,7 +2616,7 @@ gfc_resolve_ftell (gfc_expr *f, gfc_expr *u) gfc_convert_type (u, &ts, 2); } - f->value.function.name = gfc_get_string (PREFIX ("ftell2")); + f->value.function.name = gfc_get_string (PREFIX ("ftell")); } @@ -2578,6 +2678,190 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x) } +/* Build an expression for converting degrees to radians. */ + +static gfc_expr * +get_radians (gfc_expr *deg) +{ + gfc_expr *result, *factor; + gfc_actual_arglist *mod_args; + + gcc_assert (deg->ts.type == BT_REAL); + + /* Set deg = deg % 360 to avoid offsets from large angles. */ + factor = gfc_get_constant_expr (deg->ts.type, deg->ts.kind, °->where); + mpfr_set_d (factor->value.real, 360.0, GFC_RND_MODE); + + mod_args = gfc_get_actual_arglist (); + mod_args->expr = deg; + mod_args->next = gfc_get_actual_arglist (); + mod_args->next->expr = factor; + + result = gfc_get_expr (); + result->ts = deg->ts; + result->where = deg->where; + result->expr_type = EXPR_FUNCTION; + result->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_MOD); + result->value.function.actual = mod_args; + + /* Set factor = pi / 180. */ + factor = gfc_get_constant_expr (deg->ts.type, deg->ts.kind, °->where); + mpfr_const_pi (factor->value.real, GFC_RND_MODE); + mpfr_div_ui (factor->value.real, factor->value.real, 180, GFC_RND_MODE); + + /* Result is rad = (deg % 360) * (pi / 180). */ + result = gfc_multiply (result, factor); + return result; +} + + +/* Build an expression for converting radians to degrees. */ + +static gfc_expr * +get_degrees (gfc_expr *rad) +{ + gfc_expr *result, *factor; + gfc_actual_arglist *mod_args; + mpfr_t tmp; + + gcc_assert (rad->ts.type == BT_REAL); + + /* Set rad = rad % 2pi to avoid offsets from large angles. */ + factor = gfc_get_constant_expr (rad->ts.type, rad->ts.kind, &rad->where); + mpfr_const_pi (factor->value.real, GFC_RND_MODE); + mpfr_mul_ui (factor->value.real, factor->value.real, 2, GFC_RND_MODE); + + mod_args = gfc_get_actual_arglist (); + mod_args->expr = rad; + mod_args->next = gfc_get_actual_arglist (); + mod_args->next->expr = factor; + + result = gfc_get_expr (); + result->ts = rad->ts; + result->where = rad->where; + result->expr_type = EXPR_FUNCTION; + result->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_MOD); + result->value.function.actual = mod_args; + + /* Set factor = 180 / pi. */ + factor = gfc_get_constant_expr (rad->ts.type, rad->ts.kind, &rad->where); + mpfr_set_ui (factor->value.real, 180, GFC_RND_MODE); + mpfr_init (tmp); + mpfr_const_pi (tmp, GFC_RND_MODE); + mpfr_div (factor->value.real, factor->value.real, tmp, GFC_RND_MODE); + mpfr_clear (tmp); + + /* Result is deg = (rad % 2pi) * (180 / pi). */ + result = gfc_multiply (result, factor); + return result; +} + + +/* Resolve a call to a trig function. */ + +static void +resolve_trig_call (gfc_expr *f, gfc_expr *x) +{ + switch (f->value.function.isym->id) + { + case GFC_ISYM_ACOS: + return gfc_resolve_acos (f, x); + case GFC_ISYM_ASIN: + return gfc_resolve_asin (f, x); + case GFC_ISYM_ATAN: + return gfc_resolve_atan (f, x); + case GFC_ISYM_ATAN2: + /* NB. arg3 is unused for atan2 */ + return gfc_resolve_atan2 (f, x, NULL); + case GFC_ISYM_COS: + return gfc_resolve_cos (f, x); + case GFC_ISYM_COTAN: + return gfc_resolve_cotan (f, x); + case GFC_ISYM_SIN: + return gfc_resolve_sin (f, x); + case GFC_ISYM_TAN: + return gfc_resolve_tan (f, x); + default: + gcc_unreachable (); + } +} + +/* Resolve degree trig function as trigd (x) = trig (radians (x)). */ + +void +gfc_resolve_trigd (gfc_expr *f, gfc_expr *x) +{ + if (is_trig_resolved (f)) + return; + + x = get_radians (x); + f->value.function.actual->expr = x; + + resolve_trig_call (f, x); +} + + +/* Resolve degree inverse trig function as atrigd (x) = degrees (atrig (x)). */ + +void +gfc_resolve_atrigd (gfc_expr *f, gfc_expr *x) +{ + gfc_expr *result, *fcopy; + + if (is_trig_resolved (f)) + return; + + resolve_trig_call (f, x); + + fcopy = copy_replace_function_shallow (f); + result = get_degrees (fcopy); + gfc_replace_expr (f, result); +} + + +/* Resolve atan2d(x) = degrees(atan2(x)). */ + +void +gfc_resolve_atan2d (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED) +{ + /* Note that we lose the second arg here - that's okay because it is + unused in gfc_resolve_atan2 anyway. */ + gfc_resolve_atrigd (f, x); +} + + +/* Resolve failed_images (team, kind). */ + +void +gfc_resolve_failed_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED, + gfc_expr *kind) +{ + static char failed_images[] = "_gfortran_caf_failed_images"; + f->rank = 1; + f->ts.type = BT_INTEGER; + if (kind == NULL) + f->ts.kind = gfc_default_integer_kind; + else + gfc_extract_int (kind, &f->ts.kind); + f->value.function.name = failed_images; +} + + +/* Resolve image_status (image, team). */ + +void +gfc_resolve_image_status (gfc_expr *f, gfc_expr *image ATTRIBUTE_UNUSED, + gfc_expr *team ATTRIBUTE_UNUSED) +{ + static char image_status[] = "_gfortran_caf_image_status"; + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->value.function.name = image_status; +} + + +/* Resolve image_index (...). */ + void gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED, gfc_expr *sub ATTRIBUTE_UNUSED) @@ -2589,6 +2873,23 @@ gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED, } +/* Resolve stopped_images (team, kind). */ + +void +gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED, + gfc_expr *kind) +{ + static char stopped_images[] = "_gfortran_caf_stopped_images"; + f->rank = 1; + f->ts.type = BT_INTEGER; + if (kind == NULL) + f->ts.kind = gfc_default_integer_kind; + else + gfc_extract_int (kind, &f->ts.kind); + f->value.function.name = stopped_images; +} + + void gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *distance ATTRIBUTE_UNUSED) diff --git a/gcc/fortran/iso-c-binding.def b/gcc/fortran/iso-c-binding.def index c3f87e9da8..b578b27fcf 100644 --- a/gcc/fortran/iso-c-binding.def +++ b/gcc/fortran/iso-c-binding.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2006-2016 Free Software Foundation, Inc. +/* Copyright (C) 2006-2017 Free Software Foundation, Inc. This file is part of GCC. @@ -115,8 +115,8 @@ NAMED_REALCST (ISOCBINDING_DOUBLE, "c_double", \ NAMED_REALCST (ISOCBINDING_LONG_DOUBLE, "c_long_double", \ get_real_kind_from_node (long_double_type_node), GFC_STD_F2003) NAMED_REALCST (ISOCBINDING_FLOAT128, "c_float128", \ - float128_type_node == NULL_TREE \ - ? -4 : get_real_kind_from_node (float128_type_node), \ + gfc_float128_type_node == NULL_TREE \ + ? -4 : get_real_kind_from_node (gfc_float128_type_node), \ GFC_STD_GNU) NAMED_CMPXCST (ISOCBINDING_FLOAT_COMPLEX, "c_float_complex", \ get_real_kind_from_node (float_type_node), GFC_STD_F2003) @@ -125,8 +125,8 @@ NAMED_CMPXCST (ISOCBINDING_DOUBLE_COMPLEX, "c_double_complex", \ NAMED_CMPXCST (ISOCBINDING_LONG_DOUBLE_COMPLEX, "c_long_double_complex", \ get_real_kind_from_node (long_double_type_node), GFC_STD_F2003) NAMED_CMPXCST (ISOCBINDING_FLOAT128_COMPLEX, "c_float128_complex", \ - float128_type_node == NULL_TREE \ - ? -4 : get_real_kind_from_node (float128_type_node), \ + gfc_float128_type_node == NULL_TREE \ + ? -4 : get_real_kind_from_node (gfc_float128_type_node), \ GFC_STD_GNU) NAMED_LOGCST (ISOCBINDING_BOOL, "c_bool", \ diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def index 42bf7890ca..8e231a6330 100644 --- a/gcc/fortran/iso-fortran-env.def +++ b/gcc/fortran/iso-fortran-env.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2006-2016 Free Software Foundation, Inc. +/* Copyright (C) 2006-2017 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 a827bc111a..648959b7bd 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-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 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 diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index bdf5fa5fb4..4421ce4268 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -1,5 +1,5 @@ ; Options for the Fortran 95 front end. -; Copyright (C) 2003-2016 Free Software Foundation, Inc. +; Copyright (C) 2003-2017 Free Software Foundation, Inc. ; ; This file is part of GCC. ; @@ -209,6 +209,10 @@ Warray-temporaries Fortran Warning Var(warn_array_temporaries) Warn about creation of array temporaries. +Wargument-mismatch +Fortran Warning Var(warn_argument_mismatch) Init(1) +Warn about type and rank mismatches between arguments and parameters. + Wc-binding-type Fortran Var(warn_c_binding_type) Warning LangEnabledBy(Fortran,Wall) Warn if the type of a variable might be not interoperable with C. @@ -309,6 +313,10 @@ Wtabs Fortran Warning Var(warn_tabs) LangEnabledBy(Fortran,Wall || Wpedantic) Permit nonconforming uses of the tab character. +Wundefined-do-loop +Fortran Warning Var(warn_undefined_do_loop) LangEnabledBy(Fortran,Wall) +Warn about an invalid DO loop. + Wunderflow Fortran Warning Var(warn_underflow) Init(1) Warn about underflow of numerical constant expressions. @@ -351,7 +359,7 @@ Fortran Joined faggressive-function-elimination Fortran Var(flag_aggressive_function_elimination) -Eliminate multiple function invokations also for impure functions. +Eliminate multiple function invocations also for impure functions. falign-commons Fortran Var(flag_align_commons) Init(1) @@ -390,7 +398,7 @@ Fortran RejectNegative Joined Enum(gfc_convert) Var(flag_convert) Init(GFC_FLAG_ -fconvert=<big-endian|little-endian|native|swap> The endianness used for unformatted files. Enum -Name(gfc_convert) Type(enum gfc_convert) UnknownError(Unrecognized option to endianess value: %qs) +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) @@ -417,13 +425,25 @@ Fortran RejectNegative Treat lines with 'D' in column one as comments. fdec -Fortran +Fortran Var(flag_dec) Enable all DEC language extensions. +fdec-intrinsic-ints +Fortran Var(flag_dec_intrinsic_ints) +Enable kind-specific variants of integer intrinsic functions. + +fdec-math +Fortran Var(flag_dec_math) +Enable legacy math intrinsics for compatibility. + fdec-structure -Fortran +Fortran Var(flag_dec_structure) Enable support for DEC STRUCTURE/RECORD. +fdec-static +Fortran Var(flag_dec_static) +Enable DEC-style STATIC and AUTOMATIC attributes. + fdefault-double-8 Fortran Var(flag_default_double) Set the default double precision kind to an 8 byte wide type. @@ -468,6 +488,10 @@ ffixed-form Fortran RejectNegative Assume that the source file is fixed form. +ftest-forall-temp +Fortran Var(flag_test_forall_temp) Init(0) +Force creation of temporary to test infrequently-executed forall code. + finteger-4-integer-8 Fortran RejectNegative Var(flag_integer4_kind,8) Interpret any INTEGER(4) as an INTEGER(8). @@ -520,6 +544,10 @@ finit-character= Fortran RejectNegative Joined UInteger -finit-character=<n> Initialize local character variables to ASCII value n. +finit-derived +Fortran Var(flag_init_derived) +Initialize components of derived type variables according to other init flags. + finit-integer= Fortran RejectNegative Joined -finit-integer=<n> Initialize local integer variables to n. diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index e913250636..c5ff992476 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-2016 Free Software Foundation, Inc. + Copyright (C) 2007-2017 Free Software Foundation, Inc. This file is part of GCC. @@ -68,10 +68,11 @@ along with GCC; see the file COPYING3. If not see | GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO \ | GFC_RTCHECK_POINTER | GFC_RTCHECK_MEM) -/* Special unit numbers used to convey certain conditions. Numbers -3 +/* Special unit numbers used to convey certain conditions. Numbers -4 thru -9 available. NEWUNIT values start at -10. */ -#define GFC_INTERNAL_UNIT -1 -#define GFC_INVALID_UNIT -2 +#define GFC_INTERNAL_UNIT -1 /* KIND=1 Internal Unit. */ +#define GFC_INTERNAL_UNIT4 -2 /* KIND=4 Internal Unit. */ +#define GFC_INVALID_UNIT -3 /* Possible values for the CONVERT I/O specifier. */ /* Keep in sync with GFC_FLAG_CONVERT_* in gcc/flags.h. */ @@ -116,14 +117,14 @@ typedef enum } libgfortran_error_codes; -/* Must kept in sync with libgfortrancaf.h. */ +/* Must kept in sync with libgfortran/caf/libcaf.h. */ typedef enum { GFC_STAT_UNLOCKED = 0, GFC_STAT_LOCKED, GFC_STAT_LOCKED_OTHER_IMAGE, GFC_STAT_STOPPED_IMAGE = 6000, /* See LIBERROR_INQUIRE_INTERNAL_UNIT above. */ - GFC_STAT_FAILED_IMAGE + GFC_STAT_FAILED_IMAGE = 6001 } libgfortran_stat_codes; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f3a4a43a34..006ac0312a 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1,5 +1,5 @@ /* Matching subroutines in all sizes, shapes and colors. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -102,6 +102,12 @@ gfc_op2string (gfc_intrinsic_op op) case INTRINSIC_NONE: return "none"; + /* DTIO */ + case INTRINSIC_FORMATTED: + return "formatted"; + case INTRINSIC_UNFORMATTED: + return "unformatted"; + default: break; } @@ -153,7 +159,7 @@ gfc_match_member_sep(gfc_symbol *sym) return MATCH_YES; /* Beware ye who enter here. */ - if (!gfc_option.flag_dec_structure || !sym) + if (!flag_dec_structure || !sym) return MATCH_NO; tsym = NULL; @@ -215,7 +221,7 @@ gfc_match_member_sep(gfc_symbol *sym) if (c) goto yes; - gfc_error ("'%s' is neither a defined operator nor a " + gfc_error ("%qs is neither a defined operator nor a " "structure component in dotted string at %C", name); goto error; } @@ -508,7 +514,6 @@ match gfc_match_small_int (int *value) { gfc_expr *expr; - const char *p; match m; int i; @@ -516,15 +521,10 @@ gfc_match_small_int (int *value) if (m != MATCH_YES) return m; - p = gfc_extract_int (expr, &i); + if (gfc_extract_int (expr, &i, 1)) + m = MATCH_ERROR; gfc_free_expr (expr); - if (p != NULL) - { - gfc_error (p); - m = MATCH_ERROR; - } - *value = i; return m; } @@ -541,7 +541,6 @@ gfc_match_small_int (int *value) match gfc_match_small_int_expr (int *value, gfc_expr **expr) { - const char *p; match m; int i; @@ -549,13 +548,8 @@ gfc_match_small_int_expr (int *value, gfc_expr **expr) if (m != MATCH_YES) return m; - p = gfc_extract_int (*expr, &i); - - if (p != NULL) - { - gfc_error (p); - m = MATCH_ERROR; - } + if (gfc_extract_int (*expr, &i, 1)) + m = MATCH_ERROR; *value = i; return m; @@ -954,6 +948,19 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) } break; + case 'x': + if (gfc_next_ascii_char () == 'o' + && gfc_next_ascii_char () == 'r' + && gfc_next_ascii_char () == '.') + { + if (!gfc_notify_std (GFC_STD_LEGACY, ".XOR. operator at %C")) + return MATCH_ERROR; + /* Matched ".xor." - equivalent to ".neqv.". */ + *result = INTRINSIC_NEQV; + return MATCH_YES; + } + break; + default: break; } @@ -1594,6 +1601,7 @@ gfc_match_if (gfc_statement *if_type) match ("event post", gfc_match_event_post, ST_EVENT_POST) match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT) match ("exit", gfc_match_exit, ST_EXIT) + match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE) match ("flush", gfc_match_flush, ST_FLUSH) match ("forall", match_simple_forall, ST_FORALL) match ("go to", gfc_match_goto, ST_GOTO) @@ -1616,6 +1624,9 @@ gfc_match_if (gfc_statement *if_type) match ("where", match_simple_where, ST_WHERE) match ("write", gfc_match_write, ST_WRITE) + if (flag_dec) + match ("type", gfc_match_print, ST_WRITE) + /* The gfc_match_assignment() above may have returned a MATCH_NO where the assignment was to a named constant. Check that special case here. */ @@ -1983,6 +1994,7 @@ gfc_match_type_spec (gfc_typespec *ts) { match m; locus old_locus; + char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_clear_ts (ts); gfc_gobble_whitespace (); @@ -2007,13 +2019,6 @@ gfc_match_type_spec (gfc_typespec *ts) goto kind_selector; } - if (gfc_match ("real") == MATCH_YES) - { - ts->type = BT_REAL; - ts->kind = gfc_default_real_kind; - goto kind_selector; - } - if (gfc_match ("double precision") == MATCH_YES) { ts->type = BT_REAL; @@ -2047,6 +2052,103 @@ gfc_match_type_spec (gfc_typespec *ts) goto kind_selector; } + /* REAL is a real pain because it can be a type, intrinsic subprogram, + or list item in a type-list of an OpenMP reduction clause. Need to + differentiate REAL([KIND]=scalar-int-initialization-expr) from + REAL(A,[KIND]) and REAL(KIND,A). */ + + m = gfc_match (" %n", name); + if (m == MATCH_YES && strcmp (name, "real") == 0) + { + char c; + gfc_expr *e; + locus where; + + ts->type = BT_REAL; + ts->kind = gfc_default_real_kind; + + gfc_gobble_whitespace (); + + /* Prevent REAL*4, etc. */ + c = gfc_peek_ascii_char (); + if (c == '*') + { + gfc_error ("Invalid type-spec at %C"); + return MATCH_ERROR; + } + + /* Found leading colon in REAL::, a trailing ')' in for example + TYPE IS (REAL), or REAL, for an OpenMP list-item. */ + if (c == ':' || c == ')' || (flag_openmp && c == ',')) + return MATCH_YES; + + /* Found something other than the opening '(' in REAL(... */ + if (c != '(') + return MATCH_NO; + else + gfc_next_char (); /* Burn the '('. */ + + /* Look for the optional KIND=. */ + where = gfc_current_locus; + m = gfc_match ("%n", name); + if (m == MATCH_YES) + { + gfc_gobble_whitespace (); + c = gfc_next_char (); + if (c == '=') + { + if (strcmp(name, "a") == 0) + return MATCH_NO; + else if (strcmp(name, "kind") == 0) + goto found; + else + return MATCH_ERROR; + } + else + gfc_current_locus = where; + } + else + gfc_current_locus = where; + +found: + + m = gfc_match_init_expr (&e); + if (m == MATCH_NO || m == MATCH_ERROR) + return MATCH_NO; + + /* If a comma appears, it is an intrinsic subprogram. */ + gfc_gobble_whitespace (); + c = gfc_peek_ascii_char (); + if (c == ',') + { + gfc_free_expr (e); + return MATCH_NO; + } + + /* If ')' appears, we have REAL(initialization-expr), here check for + a scalar integer initialization-expr and valid kind parameter. */ + if (c == ')') + { + if (e->ts.type != BT_INTEGER || e->rank > 0) + { + gfc_free_expr (e); + return MATCH_NO; + } + + gfc_next_char (); /* Burn the ')'. */ + ts->kind = (int) mpz_get_si (e->value.integer); + if (gfc_validate_kind (BT_REAL, ts->kind , true) == -1) + { + gfc_error ("Invalid type-spec at %C"); + return MATCH_ERROR; + } + + gfc_free_expr (e); + + return MATCH_YES; + } + } + /* If a type is not matched, simply return MATCH_NO. */ gfc_current_locus = old_locus; return MATCH_NO; @@ -2054,6 +2156,8 @@ gfc_match_type_spec (gfc_typespec *ts) kind_selector: gfc_gobble_whitespace (); + + /* This prevents INTEGER*4, etc. */ if (gfc_peek_ascii_char () == '*') { gfc_error ("Invalid type-spec at %C"); @@ -2062,13 +2166,9 @@ kind_selector: m = gfc_match_kind_spec (ts, false); + /* No kind specifier found. */ if (m == MATCH_NO) - m = MATCH_YES; /* No kind specifier found. */ - - /* gfortran may have matched REAL(a=1), which is the keyword form of the - intrinsic procedure. */ - if (ts->type == BT_REAL && m == MATCH_ERROR) - m = MATCH_NO; + m = MATCH_YES; return m; } @@ -2632,8 +2732,8 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) if (o != NULL) { gfc_error (is_oacc (p) - ? "%s statement at %C leaving OpenACC structured block" - : "%s statement at %C leaving OpenMP structured block", + ? G_("%s statement at %C leaving OpenACC structured block") + : G_("%s statement at %C leaving OpenMP structured block"), gfc_ascii_statement (st)); return MATCH_ERROR; } @@ -2676,21 +2776,25 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) || o->head->op == EXEC_OMP_DO_SIMD || o->head->op == EXEC_OMP_PARALLEL_DO_SIMD)) { - int collapse = 1; + int count = 1; gcc_assert (o->head->next != NULL && (o->head->next->op == EXEC_DO || o->head->next->op == EXEC_DO_WHILE) && o->previous != NULL && o->previous->tail->op == o->head->op); - if (o->previous->tail->ext.omp_clauses != NULL - && o->previous->tail->ext.omp_clauses->collapse > 1) - collapse = o->previous->tail->ext.omp_clauses->collapse; - if (st == ST_EXIT && cnt <= collapse) + if (o->previous->tail->ext.omp_clauses != NULL) + { + if (o->previous->tail->ext.omp_clauses->collapse > 1) + count = o->previous->tail->ext.omp_clauses->collapse; + if (o->previous->tail->ext.omp_clauses->orderedc) + count = o->previous->tail->ext.omp_clauses->orderedc; + } + if (st == ST_EXIT && cnt <= count) { gfc_error ("EXIT statement at %C terminating !$OMP DO loop"); return MATCH_ERROR; } - if (st == ST_CYCLE && cnt < collapse) + if (st == ST_CYCLE && cnt < count) { gfc_error ("CYCLE statement at %C to non-innermost collapsed" " !$OMP DO loop"); @@ -2725,20 +2829,92 @@ gfc_match_cycle (void) } -/* Match a number or character constant after an (ERROR) STOP or PAUSE - statement. */ +/* Match a stop-code after an (ERROR) STOP or PAUSE statement. The + requirements for a stop-code differ in the standards. + +Fortran 95 has + + R840 stop-stmt is STOP [ stop-code ] + R841 stop-code is scalar-char-constant + or digit [ digit [ digit [ digit [ digit ] ] ] ] + +Fortran 2003 matches Fortran 95 except R840 and R841 are now R849 and R850. +Fortran 2008 has + + R855 stop-stmt is STOP [ stop-code ] + R856 allstop-stmt is ALL STOP [ stop-code ] + R857 stop-code is scalar-default-char-constant-expr + or scalar-int-constant-expr + +For free-form source code, all standards contain a statement of the form: + + A blank shall be used to separate names, constants, or labels from + adjacent keywords, names, constants, or labels. + +A stop-code is not a name, constant, or label. So, under Fortran 95 and 2003, + + STOP123 + +is valid, but it is invalid Fortran 2008. */ static match gfc_match_stopcode (gfc_statement st) { - gfc_expr *e; + gfc_expr *e = NULL; match m; + bool f95, f03; - e = NULL; + /* Set f95 for -std=f95. */ + f95 = gfc_option.allow_std == (GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77 + | GFC_STD_F2008_OBS); + + /* Set f03 for -std=f2003. */ + f03 = gfc_option.allow_std == (GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77 + | GFC_STD_F2008_OBS | GFC_STD_F2003); + + /* Look for a blank between STOP and the stop-code for F2008 or later. */ + if (gfc_current_form != FORM_FIXED && !(f95 || f03)) + { + char c = gfc_peek_ascii_char (); + + /* Look for end-of-statement. There is no stop-code. */ + if (c == '\n' || c == '!' || c == ';') + goto done; + + if (c != ' ') + { + gfc_error ("Blank required in %s statement near %C", + gfc_ascii_statement (st)); + return MATCH_ERROR; + } + } if (gfc_match_eos () != MATCH_YES) { - m = gfc_match_init_expr (&e); + int stopcode; + locus old_locus; + + /* First look for the F95 or F2003 digit [...] construct. */ + old_locus = gfc_current_locus; + m = gfc_match_small_int (&stopcode); + if (m == MATCH_YES && (f95 || f03)) + { + if (stopcode < 0) + { + gfc_error ("STOP code at %C cannot be negative"); + return MATCH_ERROR; + } + + if (stopcode > 99999) + { + gfc_error ("STOP code at %C contains too many digits"); + return MATCH_ERROR; + } + } + + /* Reset the locus and now load gfc_expr. */ + gfc_current_locus = old_locus; + m = gfc_match_expr (&e); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) @@ -2779,6 +2955,22 @@ gfc_match_stopcode (gfc_statement st) if (e != NULL) { + gfc_simplify_expr (e, 0); + + /* Test for F95 and F2003 style STOP stop-code. */ + if (e->expr_type != EXPR_CONSTANT && (f95 || f03)) + { + gfc_error ("STOP code at %L must be a scalar CHARACTER constant or " + "digit[digit[digit[digit[digit]]]]", &e->where); + goto cleanup; + } + + /* Use the machinery for an initialization expression to reduce the + stop-code to a constant. */ + gfc_init_expr_flag = true; + gfc_reduce_init_expr (e); + gfc_init_expr_flag = false; + if (!(e->ts.type == BT_CHARACTER || e->ts.type == BT_INTEGER)) { gfc_error ("STOP code at %L must be either INTEGER or CHARACTER type", @@ -2788,8 +2980,7 @@ gfc_match_stopcode (gfc_statement st) if (e->rank != 0) { - gfc_error ("STOP code at %L must be scalar", - &e->where); + gfc_error ("STOP code at %L must be scalar", &e->where); goto cleanup; } @@ -2801,8 +2992,7 @@ gfc_match_stopcode (gfc_statement st) goto cleanup; } - if (e->ts.type == BT_INTEGER - && e->ts.kind != gfc_default_integer_kind) + if (e->ts.type == BT_INTEGER && e->ts.kind != gfc_default_integer_kind) { gfc_error ("STOP code at %L must be default integer KIND=%d", &e->where, (int) gfc_default_integer_kind); @@ -2810,6 +3000,8 @@ gfc_match_stopcode (gfc_statement st) } } +done: + switch (st) { case ST_STOP: @@ -2949,7 +3141,7 @@ event_statement (gfc_statement st) { if (saw_stat) { - gfc_error ("Redundant STAT tag found at %L ", &tmp->where); + gfc_error ("Redundant STAT tag found at %L", &tmp->where); goto cleanup; } stat = tmp; @@ -2970,7 +3162,7 @@ event_statement (gfc_statement st) { if (saw_errmsg) { - gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where); + gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where); goto cleanup; } errmsg = tmp; @@ -2991,7 +3183,7 @@ event_statement (gfc_statement st) { if (saw_until_count) { - gfc_error ("Redundant UNTIL_COUNT tag found at %L ", + gfc_error ("Redundant UNTIL_COUNT tag found at %L", &tmp->where); goto cleanup; } @@ -3074,6 +3266,28 @@ gfc_match_event_wait (void) } +/* Match a FAIL IMAGE statement. */ + +match +gfc_match_fail_image (void) +{ + if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C")) + return MATCH_ERROR; + + if (gfc_match_char ('(') == MATCH_YES) + goto syntax; + + new_st.op = EXEC_FAIL_IMAGE; + + return MATCH_YES; + +syntax: + gfc_syntax_error (ST_FAIL_IMAGE); + + return MATCH_ERROR; +} + + /* Match LOCK/UNLOCK statement. Syntax: LOCK ( lock-variable [ , lock-stat-list ] ) UNLOCK ( lock-variable [ , sync-stat-list ] ) @@ -3144,7 +3358,7 @@ lock_unlock_statement (gfc_statement st) { if (saw_stat) { - gfc_error ("Redundant STAT tag found at %L ", &tmp->where); + gfc_error ("Redundant STAT tag found at %L", &tmp->where); goto cleanup; } stat = tmp; @@ -3165,7 +3379,7 @@ lock_unlock_statement (gfc_statement st) { if (saw_errmsg) { - gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where); + gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where); goto cleanup; } errmsg = tmp; @@ -3186,7 +3400,7 @@ lock_unlock_statement (gfc_statement st) { if (saw_acq_lock) { - gfc_error ("Redundant ACQUIRED_LOCK tag found at %L ", + gfc_error ("Redundant ACQUIRED_LOCK tag found at %L", &tmp->where); goto cleanup; } @@ -3356,7 +3570,7 @@ sync_statement (gfc_statement st) { if (saw_stat) { - gfc_error ("Redundant STAT tag found at %L ", &tmp->where); + gfc_error ("Redundant STAT tag found at %L", &tmp->where); goto cleanup; } stat = tmp; @@ -3376,7 +3590,7 @@ sync_statement (gfc_statement st) { if (saw_errmsg) { - gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where); + gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where); goto cleanup; } errmsg = tmp; @@ -3866,7 +4080,7 @@ alloc_opt_list: /* Enforce C630. */ if (saw_stat) { - gfc_error ("Redundant STAT tag found at %L ", &tmp->where); + gfc_error ("Redundant STAT tag found at %L", &tmp->where); goto cleanup; } @@ -3892,7 +4106,7 @@ alloc_opt_list: /* Enforce C630. */ if (saw_errmsg) { - gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where); + gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where); goto cleanup; } @@ -3915,7 +4129,7 @@ alloc_opt_list: /* Enforce C630. */ if (saw_source) { - gfc_error ("Redundant SOURCE tag found at %L ", &tmp->where); + gfc_error ("Redundant SOURCE tag found at %L", &tmp->where); goto cleanup; } @@ -3952,7 +4166,7 @@ alloc_opt_list: /* Check F08:C636. */ if (saw_mold) { - gfc_error ("Redundant MOLD tag found at %L ", &tmp->where); + gfc_error ("Redundant MOLD tag found at %L", &tmp->where); goto cleanup; } @@ -4203,7 +4417,7 @@ dealloc_opt_list: { if (saw_stat) { - gfc_error ("Redundant STAT tag found at %L ", &tmp->where); + gfc_error ("Redundant STAT tag found at %L", &tmp->where); gfc_free_expr (tmp); goto cleanup; } @@ -4228,7 +4442,7 @@ dealloc_opt_list: if (saw_errmsg) { - gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where); + gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where); gfc_free_expr (tmp); goto cleanup; } @@ -5683,6 +5897,7 @@ gfc_match_select_type (void) char name[GFC_MAX_SYMBOL_LEN]; bool class_array; gfc_symbol *sym; + gfc_namespace *ns = gfc_current_ns; m = gfc_match_label (); if (m == MATCH_ERROR) @@ -5692,11 +5907,13 @@ gfc_match_select_type (void) if (m != MATCH_YES) return m; + gfc_current_ns = gfc_build_block_ns (ns); m = gfc_match (" %n => %e", name, &expr2); if (m == MATCH_YES) { - expr1 = gfc_get_expr(); + expr1 = gfc_get_expr (); expr1->expr_type = EXPR_VARIABLE; + expr1->where = expr2->where; if (gfc_get_sym_tree (name, NULL, &expr1->symtree, false)) { m = MATCH_ERROR; @@ -5717,7 +5934,11 @@ gfc_match_select_type (void) { m = gfc_match (" %e ", &expr1); if (m != MATCH_YES) - return m; + { + std::swap (ns, gfc_current_ns); + gfc_free_namespace (ns); + return m; + } } m = gfc_match (" )%t"); @@ -5733,19 +5954,19 @@ gfc_match_select_type (void) allowed by the standard. TODO: see if it is sufficient to exclude component and substring references. */ - class_array = expr1->expr_type == EXPR_VARIABLE - && expr1->ts.type == BT_CLASS - && CLASS_DATA (expr1) - && (strcmp (CLASS_DATA (expr1)->name, "_data") == 0) - && (CLASS_DATA (expr1)->attr.dimension - || CLASS_DATA (expr1)->attr.codimension) - && expr1->ref - && expr1->ref->type == REF_ARRAY - && expr1->ref->next == NULL; + class_array = (expr1->expr_type == EXPR_VARIABLE + && expr1->ts.type == BT_CLASS + && CLASS_DATA (expr1) + && (strcmp (CLASS_DATA (expr1)->name, "_data") == 0) + && (CLASS_DATA (expr1)->attr.dimension + || CLASS_DATA (expr1)->attr.codimension) + && expr1->ref + && expr1->ref->type == REF_ARRAY + && expr1->ref->next == NULL); /* Check for F03:C811. */ if (!expr2 && (expr1->expr_type != EXPR_VARIABLE - || (!class_array && expr1->ref != NULL))) + || (!class_array && expr1->ref != NULL))) { gfc_error ("Selector in SELECT TYPE at %C is not a named variable; " "use associate-name=>"); @@ -5759,12 +5980,16 @@ gfc_match_select_type (void) new_st.ext.block.ns = gfc_current_ns; select_type_push (expr1->symtree->n.sym); + gfc_current_ns = ns; return MATCH_YES; cleanup: gfc_free_expr (expr1); gfc_free_expr (expr2); + gfc_undo_symbols (); + std::swap (ns, gfc_current_ns); + gfc_free_namespace (ns); return m; } @@ -6010,6 +6235,7 @@ match_simple_where (void) c->next = XCNEW (gfc_code); *c->next = new_st; + c->next->loc = gfc_current_locus; gfc_clear_new_st (); new_st.op = EXEC_WHERE; @@ -6066,8 +6292,12 @@ gfc_match_where (gfc_statement *st) c = gfc_get_code (EXEC_WHERE); c->expr1 = expr; + /* Put in the assignment. It will not be processed by add_statement, so we + need to copy the location here. */ + c->next = XCNEW (gfc_code); *c->next = new_st; + c->next->loc = gfc_current_locus; gfc_clear_new_st (); new_st.op = EXEC_WHERE; diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 348ca701c9..64f2038f03 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -1,5 +1,5 @@ /* All matcher functions. - Copyright (C) 2003-2016 Free Software Foundation, Inc. + Copyright (C) 2003-2017 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. @@ -73,6 +73,7 @@ match gfc_match_elseif (void); match gfc_match_event_post (void); match gfc_match_event_wait (void); match gfc_match_critical (void); +match gfc_match_fail_image (void); match gfc_match_block (void); match gfc_match_associate (void); match gfc_match_do (void); @@ -162,6 +163,7 @@ match gfc_match_omp_do_simd (void); match gfc_match_omp_flush (void); match gfc_match_omp_master (void); match gfc_match_omp_ordered (void); +match gfc_match_omp_ordered_depend (void); match gfc_match_omp_parallel (void); match gfc_match_omp_parallel_do (void); match gfc_match_omp_parallel_do_simd (void); @@ -172,6 +174,12 @@ match gfc_match_omp_simd (void); match gfc_match_omp_single (void); match gfc_match_omp_target (void); match gfc_match_omp_target_data (void); +match gfc_match_omp_target_enter_data (void); +match gfc_match_omp_target_exit_data (void); +match gfc_match_omp_target_parallel (void); +match gfc_match_omp_target_parallel_do (void); +match gfc_match_omp_target_parallel_do_simd (void); +match gfc_match_omp_target_simd (void); match gfc_match_omp_target_teams (void); match gfc_match_omp_target_teams_distribute (void); match gfc_match_omp_target_teams_distribute_parallel_do (void); @@ -180,6 +188,8 @@ match gfc_match_omp_target_teams_distribute_simd (void); match gfc_match_omp_target_update (void); match gfc_match_omp_task (void); match gfc_match_omp_taskgroup (void); +match gfc_match_omp_taskloop (void); +match gfc_match_omp_taskloop_simd (void); match gfc_match_omp_taskwait (void); match gfc_match_omp_taskyield (void); match gfc_match_omp_teams (void); @@ -189,6 +199,7 @@ match gfc_match_omp_teams_distribute_parallel_do_simd (void); match gfc_match_omp_teams_distribute_simd (void); match gfc_match_omp_threadprivate (void); match gfc_match_omp_workshare (void); +match gfc_match_omp_end_critical (void); match gfc_match_omp_end_nowait (void); match gfc_match_omp_end_single (void); @@ -214,6 +225,7 @@ match gfc_match_union (void); match gfc_match_structure_decl (void); match gfc_match_derived_decl (void); match gfc_match_final_decl (void); +match gfc_match_type (gfc_statement *); match gfc_match_implicit_none (void); match gfc_match_implicit (void); @@ -223,6 +235,7 @@ void gfc_set_constant_character_len (int, gfc_expr *, int); /* Matchers for attribute declarations. */ match gfc_match_allocatable (void); match gfc_match_asynchronous (void); +match gfc_match_automatic (void); match gfc_match_codimension (void); match gfc_match_contiguous (void); match gfc_match_dimension (void); @@ -238,6 +251,7 @@ match gfc_match_protected (void); match gfc_match_private (gfc_statement *); match gfc_match_public (gfc_statement *); match gfc_match_save (void); +match gfc_match_static (void); match gfc_match_modproc (void); match gfc_match_target (void); match gfc_match_value (void); diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c index 489d5c1d4e..978702b3a2 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.c @@ -1,5 +1,5 @@ /* Expression parser. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -25,7 +25,7 @@ along with GCC; see the file COPYING3. If not see #include "arith.h" #include "match.h" -static char expression_syntax[] = N_("Syntax error in expression at %C"); +static const char expression_syntax[] = N_("Syntax error in expression at %C"); /* Match a user-defined operator name. This is a normal name with a diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def index fc7fdc26e9..fadfedb25f 100644 --- a/gcc/fortran/mathbuiltins.def +++ b/gcc/fortran/mathbuiltins.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2004-2016 Free Software Foundation, Inc. +/* Copyright (C) 2004-2017 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c index 1747ff2ac7..a2c199efb5 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.c @@ -1,5 +1,5 @@ /* Miscellaneous stuff that doesn't fit anywhere else. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 6d3860ef82..4d6afa55d3 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -1,6 +1,6 @@ /* Handle modules, which amounts to loading and saving symbols and their attendant structures. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -193,10 +193,6 @@ static const char *module_name; /* The name of the .smod file that the submodule will write to. */ static const char *submodule_name; -/* Suppress the output of a .smod file by module, if no module - procedures have been seen. */ -static bool no_module_procedures; - static gfc_use_list *module_list; /* If we're reading an intrinsic module, this is its ID. */ @@ -428,7 +424,7 @@ gfc_dt_lower_string (const char *name) if (name[0] != (char) TOLOWER ((unsigned char) name[0])) return gfc_get_string ("%c%s", (char) TOLOWER ((unsigned char) name[0]), &name[1]); - return gfc_get_string (name); + return gfc_get_string ("%s", name); } @@ -443,7 +439,7 @@ gfc_dt_upper_string (const char *name) if (name[0] != (char) TOUPPER ((unsigned char) name[0])) return gfc_get_string ("%c%s", (char) TOUPPER ((unsigned char) name[0]), &name[1]); - return gfc_get_string (name); + return gfc_get_string ("%s", name); } /* Call here during module reading when we know what pointer to @@ -594,7 +590,7 @@ gfc_match_use (void) return m; } - use_list->module_name = gfc_get_string (name); + use_list->module_name = gfc_get_string ("%s", name); if (gfc_match_eos () == MATCH_YES) goto done; @@ -680,7 +676,7 @@ gfc_match_use (void) || strcmp (new_use->local_name, use_list->module_name) == 0) { gfc_error ("The name %qs at %C has already been used as " - "an external module name.", use_list->module_name); + "an external module name", use_list->module_name); goto cleanup; } break; @@ -740,10 +736,18 @@ gfc_match_submodule (void) match m; char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_use_list *use_list; + bool seen_colon = false; if (!gfc_notify_std (GFC_STD_F2008, "SUBMODULE declaration at %C")) return MATCH_ERROR; + if (gfc_current_state () != COMP_NONE) + { + gfc_error ("SUBMODULE declaration at %C cannot appear within " + "another scoping unit"); + return MATCH_ERROR; + } + gfc_new_block = NULL; gcc_assert (module_list == NULL); @@ -772,16 +776,19 @@ gfc_match_submodule (void) } else { - module_list = use_list; - use_list->module_name = gfc_get_string (name); + module_list = use_list; + use_list->module_name = gfc_get_string ("%s", name); use_list->submodule_name = use_list->module_name; } if (gfc_match_char (')') == MATCH_YES) break; - if (gfc_match_char (':') != MATCH_YES) + if (gfc_match_char (':') != MATCH_YES + || seen_colon) goto syntax; + + seen_colon = true; } m = gfc_match (" %s%t", &gfc_new_block); @@ -959,9 +966,9 @@ find_true_name (const char *name, const char *module) gfc_symbol sym; int c; - t.name = gfc_get_string (name); + t.name = gfc_get_string ("%s", name); if (module != NULL) - sym.module = gfc_get_string (module); + sym.module = gfc_get_string ("%s", module); else sym.module = NULL; t.sym = &sym; @@ -1951,7 +1958,8 @@ mio_pool_string (const char **stringp) else { require_atom (ATOM_STRING); - *stringp = atom_string[0] == '\0' ? NULL : gfc_get_string (atom_string); + *stringp = (atom_string[0] == '\0' + ? NULL : gfc_get_string ("%s", atom_string)); free (atom_string); } } @@ -1988,7 +1996,8 @@ enum ab_attribute AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET, AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE, AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR, - AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK + AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK, + AB_OMP_DECLARE_TARGET_LINK }; static const mstring attr_bits[] = @@ -2051,6 +2060,7 @@ static const mstring attr_bits[] = minit ("OACC_DECLARE_DEVICEPTR", AB_OACC_DECLARE_DEVICEPTR), minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT), minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK), + minit ("OMP_DECLARE_TARGET_LINK", AB_OMP_DECLARE_TARGET_LINK), minit (NULL, -1) }; @@ -2236,10 +2246,7 @@ mio_symbol_attribute (symbol_attribute *attr) if (attr->array_outer_dependency) MIO_NAME (ab_attribute) (AB_ARRAY_OUTER_DEPENDENCY, attr_bits); if (attr->module_procedure) - { MIO_NAME (ab_attribute) (AB_MODULE_PROCEDURE, attr_bits); - no_module_procedures = false; - } if (attr->oacc_declare_create) MIO_NAME (ab_attribute) (AB_OACC_DECLARE_CREATE, attr_bits); if (attr->oacc_declare_copyin) @@ -2250,6 +2257,8 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICE_RESIDENT, attr_bits); if (attr->oacc_declare_link) MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits); + if (attr->omp_declare_target_link) + MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET_LINK, attr_bits); mio_rparen (); @@ -2419,6 +2428,9 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_OMP_DECLARE_TARGET: attr->omp_declare_target = 1; break; + case AB_OMP_DECLARE_TARGET_LINK: + attr->omp_declare_target_link = 1; + break; case AB_ARRAY_OUTER_DEPENDENCY: attr->array_outer_dependency =1; break; @@ -2956,7 +2968,7 @@ mio_symtree_ref (gfc_symtree **stp) { p->u.rsym.sym = gfc_new_symbol (p->u.rsym.true_name, gfc_current_ns); - p->u.rsym.sym->module = gfc_get_string (p->u.rsym.module); + p->u.rsym.sym->module = gfc_get_string ("%s", p->u.rsym.module); } p->u.rsym.symtree->n.sym = p->u.rsym.sym; @@ -3520,7 +3532,7 @@ mio_expr (gfc_expr **ep) if (atom_string[0] == '\0') e->value.function.name = NULL; else - e->value.function.name = gfc_get_string (atom_string); + e->value.function.name = gfc_get_string ("%s", atom_string); free (atom_string); mio_integer (&flag); @@ -4155,13 +4167,13 @@ mio_omp_udr_expr (gfc_omp_udr *udr, gfc_symbol **sym1, gfc_symbol **sym2, q->u.pointer = (void *) ns; sym = gfc_new_symbol (is_initializer ? "omp_priv" : "omp_out", ns); sym->ts = udr->ts; - sym->module = gfc_get_string (p1->u.rsym.module); + sym->module = gfc_get_string ("%s", p1->u.rsym.module); associate_integer_pointer (p1, sym); sym->attr.omp_udr_artificial_var = 1; gcc_assert (p2->u.rsym.sym == NULL); sym = gfc_new_symbol (is_initializer ? "omp_orig" : "omp_in", ns); sym->ts = udr->ts; - sym->module = gfc_get_string (p2->u.rsym.module); + sym->module = gfc_get_string ("%s", p2->u.rsym.module); associate_integer_pointer (p2, sym); sym->attr.omp_udr_artificial_var = 1; if (mio_name (0, omp_declare_reduction_stmt) == 0) @@ -4280,31 +4292,6 @@ mio_symbol (gfc_symbol *sym) /************************* Top level subroutines *************************/ -/* Given a root symtree node and a symbol, try to find a symtree that - references the symbol that is not a unique name. */ - -static gfc_symtree * -find_symtree_for_symbol (gfc_symtree *st, gfc_symbol *sym) -{ - gfc_symtree *s = NULL; - - if (st == NULL) - return s; - - s = find_symtree_for_symbol (st->right, sym); - if (s != NULL) - return s; - s = find_symtree_for_symbol (st->left, sym); - if (s != NULL) - return s; - - if (st->n.sym == sym && !check_unique_name (st->name)) - return st; - - return s; -} - - /* A recursive function to look for a specific symbol by name and by module. Whilst several symtrees might point to one symbol, its is sufficient for the purposes here than one exist. Note that @@ -4503,7 +4490,7 @@ load_generic_interfaces (void) if (!sym) { gfc_get_symbol (p, NULL, &sym); - sym->name = gfc_get_string (name); + sym->name = gfc_get_string ("%s", name); sym->module = module_name; sym->attr.flavor = FL_PROCEDURE; sym->attr.generic = 1; @@ -4691,7 +4678,7 @@ load_omp_udrs (void) mio_lparen (); while (peek_atom () != ATOM_RPAREN) { - const char *name, *newname; + const char *name = NULL, *newname; char *altname; gfc_typespec ts; gfc_symtree *st; @@ -4699,6 +4686,7 @@ load_omp_udrs (void) mio_lparen (); mio_pool_string (&name); + gfc_clear_ts (&ts); mio_typespec (&ts); if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0) { @@ -4745,7 +4733,7 @@ load_omp_udrs (void) memcpy (altname + 1, newname, len); altname[len + 1] = '.'; altname[len + 2] = '\0'; - name = gfc_get_string (altname); + name = gfc_get_string ("%s", altname); } st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name); gfc_omp_udr *udr = gfc_omp_udr_find (st, &ts); @@ -4847,7 +4835,7 @@ load_needed (pointer_info *p) sym = gfc_new_symbol (p->u.rsym.true_name, ns); sym->name = gfc_dt_lower_string (p->u.rsym.true_name); - sym->module = gfc_get_string (p->u.rsym.module); + sym->module = gfc_get_string ("%s", p->u.rsym.module); if (p->u.rsym.binding_label) sym->binding_label = IDENTIFIER_POINTER (get_identifier (p->u.rsym.binding_label)); @@ -5106,16 +5094,6 @@ read_module (void) info->u.rsym.referenced = 1; continue; } - - /* If possible recycle the symtree that references the symbol. - If a symtree is not found and the module does not import one, - a unique-name symtree is found by read_cleanup. */ - st = find_symtree_for_symbol (gfc_current_ns->sym_root, sym); - if (st != NULL) - { - info->u.rsym.symtree = st; - info->u.rsym.referenced = 1; - } } mio_rparen (); @@ -5222,12 +5200,13 @@ read_module (void) gfc_current_ns); info->u.rsym.sym->name = gfc_dt_lower_string (info->u.rsym.true_name); sym = info->u.rsym.sym; - sym->module = gfc_get_string (info->u.rsym.module); + sym->module = gfc_get_string ("%s", info->u.rsym.module); if (info->u.rsym.binding_label) - sym->binding_label = - IDENTIFIER_POINTER (get_identifier - (info->u.rsym.binding_label)); + { + tree id = get_identifier (info->u.rsym.binding_label); + sym->binding_label = IDENTIFIER_POINTER (id); + } } st->n.sym = sym; @@ -6033,7 +6012,7 @@ dump_module (const char *name, int dump_flag) char *filename, *filename_tmp; uLong crc, crc_old; - module_name = gfc_get_string (name); + module_name = gfc_get_string ("%s", name); if (dump_smod) { @@ -6125,6 +6104,18 @@ dump_module (const char *name, int dump_flag) } +/* Suppress the output of a .smod file by module, if no module + procedures have been seen. */ +static bool no_module_procedures; + +static void +check_for_module_procedures (gfc_symbol *sym) +{ + if (sym && sym->attr.module_procedure) + no_module_procedures = false; +} + + void gfc_dump_module (const char *name, int dump_flag) { @@ -6134,6 +6125,8 @@ gfc_dump_module (const char *name, int dump_flag) dump_smod =false; no_module_procedures = true; + gfc_traverse_ns (gfc_current_ns, check_for_module_procedures); + dump_module (name, dump_flag); if (no_module_procedures || dump_smod) @@ -6159,9 +6152,11 @@ create_intrinsic_function (const char *name, int id, tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name); if (tmp_symtree) { - if (strcmp (modname, tmp_symtree->n.sym->module) == 0) - return; - gfc_error ("Symbol %qs already declared", name); + if (tmp_symtree->n.sym && tmp_symtree->n.sym->module + && strcmp (modname, tmp_symtree->n.sym->module) == 0) + return; + gfc_error ("Symbol %qs at %C already declared", name); + return; } gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false); @@ -6196,7 +6191,7 @@ create_intrinsic_function (const char *name, int id, sym->attr.flavor = FL_PROCEDURE; sym->attr.intrinsic = 1; - sym->module = gfc_get_string (modname); + sym->module = gfc_get_string ("%s", modname); sym->attr.use_assoc = 1; sym->from_intmod = module; sym->intmod_sym_id = id; @@ -6236,7 +6231,7 @@ import_iso_c_binding_module (void) mod_sym->attr.flavor = FL_MODULE; mod_sym->attr.intrinsic = 1; - mod_sym->module = gfc_get_string (iso_c_module_name); + mod_sym->module = gfc_get_string ("%s", iso_c_module_name); mod_sym->from_intmod = INTMOD_ISO_C_BINDING; } @@ -6494,7 +6489,7 @@ create_int_parameter (const char *name, int value, const char *modname, gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false); sym = tmp_symtree->n.sym; - sym->module = gfc_get_string (modname); + sym->module = gfc_get_string ("%s", modname); sym->attr.flavor = FL_PARAMETER; sym->ts.type = BT_INTEGER; sym->ts.kind = gfc_default_integer_kind; @@ -6527,7 +6522,7 @@ create_int_parameter_array (const char *name, int size, gfc_expr *value, gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false); sym = tmp_symtree->n.sym; - sym->module = gfc_get_string (modname); + sym->module = gfc_get_string ("%s", modname); sym->attr.flavor = FL_PARAMETER; sym->ts.type = BT_INTEGER; sym->ts.kind = gfc_default_integer_kind; @@ -6568,7 +6563,7 @@ create_derived_type (const char *name, const char *modname, gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false); sym = tmp_symtree->n.sym; - sym->module = gfc_get_string (modname); + sym->module = gfc_get_string ("%s", modname); sym->from_intmod = module; sym->intmod_sym_id = id; sym->attr.flavor = FL_PROCEDURE; @@ -6578,12 +6573,12 @@ create_derived_type (const char *name, const char *modname, gfc_get_sym_tree (gfc_dt_upper_string (sym->name), gfc_current_ns, &tmp_symtree, false); dt_sym = tmp_symtree->n.sym; - dt_sym->name = gfc_get_string (sym->name); + dt_sym->name = gfc_get_string ("%s", sym->name); dt_sym->attr.flavor = FL_DERIVED; dt_sym->attr.private_comp = 1; dt_sym->attr.zero_comp = 1; dt_sym->attr.use_assoc = 1; - dt_sym->module = gfc_get_string (modname); + dt_sym->module = gfc_get_string ("%s", modname); dt_sym->from_intmod = module; dt_sym->intmod_sym_id = id; @@ -6663,7 +6658,7 @@ use_iso_fortran_env_module (void) mod_sym->attr.flavor = FL_MODULE; mod_sym->attr.intrinsic = 1; - mod_sym->module = gfc_get_string (mod); + mod_sym->module = gfc_get_string ("%s", mod); mod_sym->from_intmod = INTMOD_ISO_FORTRAN_ENV; } else @@ -6917,8 +6912,17 @@ gfc_use_module (gfc_use_list *module) } if (module_fp == NULL) - gfc_fatal_error ("Can't open module file %qs for reading at %C: %s", - filename, xstrerror (errno)); + { + if (gfc_state_stack->state != COMP_SUBMODULE + && module->submodule_name == NULL) + gfc_fatal_error ("Can't open module file %qs for reading at %C: %s", + filename, xstrerror (errno)); + else + gfc_fatal_error ("Module file %qs has not been generated, either " + "because the module does not contain a MODULE " + "PROCEDURE or there is an error in the module.", + filename); + } /* Check that we haven't already USEd an intrinsic module with the same name. */ diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index de9a4ad47a..89eecfa2ed 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1,5 +1,5 @@ /* OpenMP directive matching and resolving. - Copyright (C) 2005-2016 Free Software Foundation, Inc. + Copyright (C) 2005-2017 Free Software Foundation, Inc. Contributed by Jakub Jelinek This file is part of GCC. @@ -76,6 +76,12 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->device); gfc_free_expr (c->thread_limit); gfc_free_expr (c->dist_chunk_size); + gfc_free_expr (c->grainsize); + gfc_free_expr (c->hint); + gfc_free_expr (c->num_tasks); + gfc_free_expr (c->priority); + for (i = 0; i < OMP_IF_LAST; i++) + gfc_free_expr (c->if_exprs[i]); gfc_free_expr (c->async_expr); gfc_free_expr (c->gang_num_expr); gfc_free_expr (c->gang_static_expr); @@ -88,6 +94,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_omp_namelist (c->lists[i]); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); + free (CONST_CAST (char *, c->critical_name)); free (c); } @@ -333,6 +340,170 @@ cleanup: return MATCH_ERROR; } +/* Match a variable/procedure/common block list and construct a namelist + from it. */ + +static match +gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list) +{ + gfc_omp_namelist *head, *tail, *p; + locus old_loc, cur_loc; + char n[GFC_MAX_SYMBOL_LEN+1]; + gfc_symbol *sym; + match m; + gfc_symtree *st; + + head = tail = NULL; + + old_loc = gfc_current_locus; + + m = gfc_match (str); + if (m != MATCH_YES) + return m; + + for (;;) + { + cur_loc = gfc_current_locus; + m = gfc_match_symbol (&sym, 1); + switch (m) + { + case MATCH_YES: + p = gfc_get_omp_namelist (); + if (head == NULL) + head = tail = p; + else + { + tail->next = p; + tail = tail->next; + } + tail->sym = sym; + tail->where = cur_loc; + goto next_item; + case MATCH_NO: + break; + case MATCH_ERROR: + goto cleanup; + } + + m = gfc_match (" / %n /", n); + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO) + goto syntax; + + st = gfc_find_symtree (gfc_current_ns->common_root, n); + if (st == NULL) + { + gfc_error ("COMMON block /%s/ not found at %C", n); + goto cleanup; + } + p = gfc_get_omp_namelist (); + if (head == NULL) + head = tail = p; + else + { + tail->next = p; + tail = tail->next; + } + tail->u.common = st->n.common; + tail->where = cur_loc; + + next_item: + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + + while (*list) + list = &(*list)->next; + + *list = head; + return MATCH_YES; + +syntax: + gfc_error ("Syntax error in OpenMP variable list at %C"); + +cleanup: + gfc_free_omp_namelist (head); + gfc_current_locus = old_loc; + return MATCH_ERROR; +} + +/* Match depend(sink : ...) construct a namelist from it. */ + +static match +gfc_match_omp_depend_sink (gfc_omp_namelist **list) +{ + gfc_omp_namelist *head, *tail, *p; + locus old_loc, cur_loc; + gfc_symbol *sym; + + head = tail = NULL; + + old_loc = gfc_current_locus; + + for (;;) + { + cur_loc = gfc_current_locus; + switch (gfc_match_symbol (&sym, 1)) + { + case MATCH_YES: + gfc_set_sym_referenced (sym); + p = gfc_get_omp_namelist (); + if (head == NULL) + { + head = tail = p; + head->u.depend_op = OMP_DEPEND_SINK_FIRST; + } + else + { + tail->next = p; + tail = tail->next; + tail->u.depend_op = OMP_DEPEND_SINK; + } + tail->sym = sym; + tail->expr = NULL; + tail->where = cur_loc; + if (gfc_match_char ('+') == MATCH_YES) + { + if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES) + goto syntax; + } + else if (gfc_match_char ('-') == MATCH_YES) + { + if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES) + goto syntax; + tail->expr = gfc_uminus (tail->expr); + } + break; + case MATCH_NO: + goto syntax; + case MATCH_ERROR: + goto cleanup; + } + + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + + while (*list) + list = &(*list)->next; + + *list = head; + return MATCH_YES; + +syntax: + gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C"); + +cleanup: + gfc_free_omp_namelist (head); + gfc_current_locus = old_loc; + return MATCH_ERROR; +} + static match match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk) @@ -563,67 +734,183 @@ cleanup: return MATCH_ERROR; } -#define OMP_CLAUSE_PRIVATE ((uint64_t) 1 << 0) -#define OMP_CLAUSE_FIRSTPRIVATE ((uint64_t) 1 << 1) -#define OMP_CLAUSE_LASTPRIVATE ((uint64_t) 1 << 2) -#define OMP_CLAUSE_COPYPRIVATE ((uint64_t) 1 << 3) -#define OMP_CLAUSE_SHARED ((uint64_t) 1 << 4) -#define OMP_CLAUSE_COPYIN ((uint64_t) 1 << 5) -#define OMP_CLAUSE_REDUCTION ((uint64_t) 1 << 6) -#define OMP_CLAUSE_IF ((uint64_t) 1 << 7) -#define OMP_CLAUSE_NUM_THREADS ((uint64_t) 1 << 8) -#define OMP_CLAUSE_SCHEDULE ((uint64_t) 1 << 9) -#define OMP_CLAUSE_DEFAULT ((uint64_t) 1 << 10) -#define OMP_CLAUSE_ORDERED ((uint64_t) 1 << 11) -#define OMP_CLAUSE_COLLAPSE ((uint64_t) 1 << 12) -#define OMP_CLAUSE_UNTIED ((uint64_t) 1 << 13) -#define OMP_CLAUSE_FINAL ((uint64_t) 1 << 14) -#define OMP_CLAUSE_MERGEABLE ((uint64_t) 1 << 15) -#define OMP_CLAUSE_ALIGNED ((uint64_t) 1 << 16) -#define OMP_CLAUSE_DEPEND ((uint64_t) 1 << 17) -#define OMP_CLAUSE_INBRANCH ((uint64_t) 1 << 18) -#define OMP_CLAUSE_LINEAR ((uint64_t) 1 << 19) -#define OMP_CLAUSE_NOTINBRANCH ((uint64_t) 1 << 20) -#define OMP_CLAUSE_PROC_BIND ((uint64_t) 1 << 21) -#define OMP_CLAUSE_SAFELEN ((uint64_t) 1 << 22) -#define OMP_CLAUSE_SIMDLEN ((uint64_t) 1 << 23) -#define OMP_CLAUSE_UNIFORM ((uint64_t) 1 << 24) -#define OMP_CLAUSE_DEVICE ((uint64_t) 1 << 25) -#define OMP_CLAUSE_MAP ((uint64_t) 1 << 26) -#define OMP_CLAUSE_TO ((uint64_t) 1 << 27) -#define OMP_CLAUSE_FROM ((uint64_t) 1 << 28) -#define OMP_CLAUSE_NUM_TEAMS ((uint64_t) 1 << 29) -#define OMP_CLAUSE_THREAD_LIMIT ((uint64_t) 1 << 30) -#define OMP_CLAUSE_DIST_SCHEDULE ((uint64_t) 1 << 31) - -/* OpenACC 2.0 clauses. */ -#define OMP_CLAUSE_ASYNC ((uint64_t) 1 << 32) -#define OMP_CLAUSE_NUM_GANGS ((uint64_t) 1 << 33) -#define OMP_CLAUSE_NUM_WORKERS ((uint64_t) 1 << 34) -#define OMP_CLAUSE_VECTOR_LENGTH ((uint64_t) 1 << 35) -#define OMP_CLAUSE_COPY ((uint64_t) 1 << 36) -#define OMP_CLAUSE_COPYOUT ((uint64_t) 1 << 37) -#define OMP_CLAUSE_CREATE ((uint64_t) 1 << 38) -#define OMP_CLAUSE_PRESENT ((uint64_t) 1 << 39) -#define OMP_CLAUSE_PRESENT_OR_COPY ((uint64_t) 1 << 40) -#define OMP_CLAUSE_PRESENT_OR_COPYIN ((uint64_t) 1 << 41) -#define OMP_CLAUSE_PRESENT_OR_COPYOUT ((uint64_t) 1 << 42) -#define OMP_CLAUSE_PRESENT_OR_CREATE ((uint64_t) 1 << 43) -#define OMP_CLAUSE_DEVICEPTR ((uint64_t) 1 << 44) -#define OMP_CLAUSE_GANG ((uint64_t) 1 << 45) -#define OMP_CLAUSE_WORKER ((uint64_t) 1 << 46) -#define OMP_CLAUSE_VECTOR ((uint64_t) 1 << 47) -#define OMP_CLAUSE_SEQ ((uint64_t) 1 << 48) -#define OMP_CLAUSE_INDEPENDENT ((uint64_t) 1 << 49) -#define OMP_CLAUSE_USE_DEVICE ((uint64_t) 1 << 50) -#define OMP_CLAUSE_DEVICE_RESIDENT ((uint64_t) 1 << 51) -#define OMP_CLAUSE_HOST_SELF ((uint64_t) 1 << 52) -#define OMP_CLAUSE_OACC_DEVICE ((uint64_t) 1 << 53) -#define OMP_CLAUSE_WAIT ((uint64_t) 1 << 54) -#define OMP_CLAUSE_DELETE ((uint64_t) 1 << 55) -#define OMP_CLAUSE_AUTO ((uint64_t) 1 << 56) -#define OMP_CLAUSE_TILE ((uint64_t) 1 << 57) -#define OMP_CLAUSE_LINK ((uint64_t) 1 << 58) +/* OpenMP 4.5 clauses. */ +enum omp_mask1 +{ + OMP_CLAUSE_PRIVATE, + OMP_CLAUSE_FIRSTPRIVATE, + OMP_CLAUSE_LASTPRIVATE, + OMP_CLAUSE_COPYPRIVATE, + OMP_CLAUSE_SHARED, + OMP_CLAUSE_COPYIN, + OMP_CLAUSE_REDUCTION, + OMP_CLAUSE_IF, + OMP_CLAUSE_NUM_THREADS, + OMP_CLAUSE_SCHEDULE, + OMP_CLAUSE_DEFAULT, + OMP_CLAUSE_ORDERED, + OMP_CLAUSE_COLLAPSE, + OMP_CLAUSE_UNTIED, + OMP_CLAUSE_FINAL, + OMP_CLAUSE_MERGEABLE, + OMP_CLAUSE_ALIGNED, + OMP_CLAUSE_DEPEND, + OMP_CLAUSE_INBRANCH, + OMP_CLAUSE_LINEAR, + OMP_CLAUSE_NOTINBRANCH, + OMP_CLAUSE_PROC_BIND, + OMP_CLAUSE_SAFELEN, + OMP_CLAUSE_SIMDLEN, + OMP_CLAUSE_UNIFORM, + OMP_CLAUSE_DEVICE, + OMP_CLAUSE_MAP, + OMP_CLAUSE_TO, + OMP_CLAUSE_FROM, + OMP_CLAUSE_NUM_TEAMS, + OMP_CLAUSE_THREAD_LIMIT, + OMP_CLAUSE_DIST_SCHEDULE, + OMP_CLAUSE_DEFAULTMAP, + OMP_CLAUSE_GRAINSIZE, + OMP_CLAUSE_HINT, + OMP_CLAUSE_IS_DEVICE_PTR, + OMP_CLAUSE_LINK, + OMP_CLAUSE_NOGROUP, + OMP_CLAUSE_NUM_TASKS, + OMP_CLAUSE_PRIORITY, + OMP_CLAUSE_SIMD, + OMP_CLAUSE_THREADS, + OMP_CLAUSE_USE_DEVICE_PTR, + OMP_CLAUSE_NOWAIT, + /* This must come last. */ + OMP_MASK1_LAST +}; + +/* OpenACC 2.0 specific clauses. */ +enum omp_mask2 +{ + OMP_CLAUSE_ASYNC, + OMP_CLAUSE_NUM_GANGS, + OMP_CLAUSE_NUM_WORKERS, + OMP_CLAUSE_VECTOR_LENGTH, + OMP_CLAUSE_COPY, + OMP_CLAUSE_COPYOUT, + OMP_CLAUSE_CREATE, + OMP_CLAUSE_PRESENT, + OMP_CLAUSE_PRESENT_OR_COPY, + OMP_CLAUSE_PRESENT_OR_COPYIN, + OMP_CLAUSE_PRESENT_OR_COPYOUT, + OMP_CLAUSE_PRESENT_OR_CREATE, + OMP_CLAUSE_DEVICEPTR, + OMP_CLAUSE_GANG, + OMP_CLAUSE_WORKER, + OMP_CLAUSE_VECTOR, + OMP_CLAUSE_SEQ, + OMP_CLAUSE_INDEPENDENT, + OMP_CLAUSE_USE_DEVICE, + OMP_CLAUSE_DEVICE_RESIDENT, + OMP_CLAUSE_HOST_SELF, + OMP_CLAUSE_WAIT, + OMP_CLAUSE_DELETE, + OMP_CLAUSE_AUTO, + OMP_CLAUSE_TILE, + /* This must come last. */ + OMP_MASK2_LAST +}; + +struct omp_inv_mask; + +/* Customized bitset for up to 128-bits. + The two enums above provide bit numbers to use, and which of the + two enums it is determines which of the two mask fields is used. + Supported operations are defining a mask, like: + #define XXX_CLAUSES \ + (omp_mask (OMP_CLAUSE_XXX) | OMP_CLAUSE_YYY | OMP_CLAUSE_ZZZ) + oring such bitsets together or removing selected bits: + (XXX_CLAUSES | YYY_CLAUSES) & ~(omp_mask (OMP_CLAUSE_VVV)) + and testing individual bits: + if (mask & OMP_CLAUSE_UUU) */ + +struct omp_mask { + const uint64_t mask1; + const uint64_t mask2; + inline omp_mask (); + inline omp_mask (omp_mask1); + inline omp_mask (omp_mask2); + inline omp_mask (uint64_t, uint64_t); + inline omp_mask operator| (omp_mask1) const; + inline omp_mask operator| (omp_mask2) const; + inline omp_mask operator| (omp_mask) const; + inline omp_mask operator& (const omp_inv_mask &) const; + inline bool operator& (omp_mask1) const; + inline bool operator& (omp_mask2) const; + inline omp_inv_mask operator~ () const; +}; + +struct omp_inv_mask : public omp_mask { + inline omp_inv_mask (const omp_mask &); +}; + +omp_mask::omp_mask () : mask1 (0), mask2 (0) +{ +} + +omp_mask::omp_mask (omp_mask1 m) : mask1 (((uint64_t) 1) << m), mask2 (0) +{ +} + +omp_mask::omp_mask (omp_mask2 m) : mask1 (0), mask2 (((uint64_t) 1) << m) +{ +} + +omp_mask::omp_mask (uint64_t m1, uint64_t m2) : mask1 (m1), mask2 (m2) +{ +} + +omp_mask +omp_mask::operator| (omp_mask1 m) const +{ + return omp_mask (mask1 | (((uint64_t) 1) << m), mask2); +} + +omp_mask +omp_mask::operator| (omp_mask2 m) const +{ + return omp_mask (mask1, mask2 | (((uint64_t) 1) << m)); +} + +omp_mask +omp_mask::operator| (omp_mask m) const +{ + return omp_mask (mask1 | m.mask1, mask2 | m.mask2); +} + +omp_mask +omp_mask::operator& (const omp_inv_mask &m) const +{ + return omp_mask (mask1 & ~m.mask1, mask2 & ~m.mask2); +} + +bool +omp_mask::operator& (omp_mask1 m) const +{ + return (mask1 & (((uint64_t) 1) << m)) != 0; +} + +bool +omp_mask::operator& (omp_mask2 m) const +{ + return (mask2 & (((uint64_t) 1) << m)) != 0; +} + +omp_inv_mask +omp_mask::operator~ () const +{ + return omp_inv_mask (*this); +} + +omp_inv_mask::omp_inv_mask (const omp_mask &m) : omp_mask (m) +{ +} /* Helper function for OpenACC and OpenMP clauses involving memory mapping. */ @@ -648,13 +935,14 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op) clauses that are allowed for a particular directive. */ static match -gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, +gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, bool first = true, bool needs_space = true, bool openacc = false) { gfc_omp_clauses *c = gfc_get_omp_clauses (); locus old_loc; + gcc_checking_assert (OMP_MASK1_LAST <= 64 && OMP_MASK2_LAST <= 64); *cp = NULL; while (1) { @@ -664,670 +952,957 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, needs_space = false; first = false; gfc_gobble_whitespace (); + bool end_colon; + gfc_omp_namelist **head; old_loc = gfc_current_locus; - if ((mask & OMP_CLAUSE_ASYNC) && !c->async) - if (gfc_match ("async") == MATCH_YES) - { - c->async = true; - match m = gfc_match (" ( %e )", &c->async_expr); - if (m == MATCH_ERROR) - { - gfc_current_locus = old_loc; - break; - } - else if (m == MATCH_NO) - { - c->async_expr - = gfc_get_constant_expr (BT_INTEGER, - gfc_default_integer_kind, - &gfc_current_locus); - mpz_set_si (c->async_expr->value.integer, GOMP_ASYNC_NOVAL); - needs_space = true; - } - continue; - } - if ((mask & OMP_CLAUSE_GANG) && !c->gang) - if (gfc_match ("gang") == MATCH_YES) - { - c->gang = true; - match m = match_oacc_clause_gwv (c, GOMP_DIM_GANG); - if (m == MATCH_ERROR) - { - gfc_current_locus = old_loc; - break; - } - else if (m == MATCH_NO) + char pc = gfc_peek_ascii_char (); + switch (pc) + { + case 'a': + end_colon = false; + head = NULL; + if ((mask & OMP_CLAUSE_ALIGNED) + && gfc_match_omp_variable_list ("aligned (", + &c->lists[OMP_LIST_ALIGNED], + false, &end_colon, + &head) == MATCH_YES) + { + gfc_expr *alignment = NULL; + gfc_omp_namelist *n; + + if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES) + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + for (n = *head; n; n = n->next) + if (n->next && alignment) + n->expr = gfc_copy_expr (alignment); + else + n->expr = alignment; + continue; + } + if ((mask & OMP_CLAUSE_ASYNC) + && !c->async + && gfc_match ("async") == MATCH_YES) + { + c->async = true; + match m = gfc_match (" ( %e )", &c->async_expr); + if (m == MATCH_ERROR) + { + gfc_current_locus = old_loc; + break; + } + else if (m == MATCH_NO) + { + c->async_expr + = gfc_get_constant_expr (BT_INTEGER, + gfc_default_integer_kind, + &gfc_current_locus); + mpz_set_si (c->async_expr->value.integer, GOMP_ASYNC_NOVAL); + needs_space = true; + } + continue; + } + if ((mask & OMP_CLAUSE_AUTO) + && !c->par_auto + && gfc_match ("auto") == MATCH_YES) + { + c->par_auto = true; needs_space = true; + continue; + } + break; + case 'c': + if ((mask & OMP_CLAUSE_COLLAPSE) + && !c->collapse) + { + gfc_expr *cexpr = NULL; + match m = gfc_match ("collapse ( %e )", &cexpr); + + if (m == MATCH_YES) + { + int collapse; + if (gfc_extract_int (cexpr, &collapse, -1)) + collapse = 1; + else if (collapse <= 0) + { + gfc_error_now ("COLLAPSE clause argument not" + " constant positive integer at %C"); + collapse = 1; + } + c->collapse = collapse; + gfc_free_expr (cexpr); + continue; + } + } + if ((mask & OMP_CLAUSE_COPY) + && gfc_match ("copy ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FORCE_TOFROM)) continue; - } - if ((mask & OMP_CLAUSE_WORKER) && !c->worker) - if (gfc_match ("worker") == MATCH_YES) - { - c->worker = true; - match m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER); - if (m == MATCH_ERROR) - { - gfc_current_locus = old_loc; - break; - } - else if (m == MATCH_NO) - needs_space = true; + if (mask & OMP_CLAUSE_COPYIN) + { + if (openacc) + { + if (gfc_match ("copyin ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FORCE_TO)) + continue; + } + else if (gfc_match_omp_variable_list ("copyin (", + &c->lists[OMP_LIST_COPYIN], + true) == MATCH_YES) + continue; + } + if ((mask & OMP_CLAUSE_COPYOUT) + && gfc_match ("copyout ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FORCE_FROM)) continue; - } - if ((mask & OMP_CLAUSE_VECTOR_LENGTH) && c->vector_length_expr == NULL - && gfc_match ("vector_length ( %e )", &c->vector_length_expr) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_VECTOR) && !c->vector) - if (gfc_match ("vector") == MATCH_YES) - { - c->vector = true; - match m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR); - if (m == MATCH_ERROR) - { + if ((mask & OMP_CLAUSE_COPYPRIVATE) + && gfc_match_omp_variable_list ("copyprivate (", + &c->lists[OMP_LIST_COPYPRIVATE], + true) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_CREATE) + && gfc_match ("create ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FORCE_ALLOC)) + continue; + break; + case 'd': + if ((mask & OMP_CLAUSE_DEFAULT) + && c->default_sharing == OMP_DEFAULT_UNKNOWN) + { + if (gfc_match ("default ( none )") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_NONE; + else if (openacc) + /* c->default_sharing = OMP_DEFAULT_UNKNOWN */; + else if (gfc_match ("default ( shared )") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_SHARED; + else if (gfc_match ("default ( private )") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_PRIVATE; + else if (gfc_match ("default ( firstprivate )") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE; + if (c->default_sharing != OMP_DEFAULT_UNKNOWN) + continue; + } + if ((mask & OMP_CLAUSE_DEFAULTMAP) + && !c->defaultmap + && gfc_match ("defaultmap ( tofrom : scalar )") == MATCH_YES) + { + c->defaultmap = true; + continue; + } + if ((mask & OMP_CLAUSE_DELETE) + && gfc_match ("delete ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_DELETE)) + continue; + if ((mask & OMP_CLAUSE_DEPEND) + && gfc_match ("depend ( ") == MATCH_YES) + { + match m = MATCH_YES; + gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; + if (gfc_match ("inout") == MATCH_YES) + depend_op = OMP_DEPEND_INOUT; + else if (gfc_match ("in") == MATCH_YES) + depend_op = OMP_DEPEND_IN; + else if (gfc_match ("out") == MATCH_YES) + depend_op = OMP_DEPEND_OUT; + else if (!c->depend_source + && gfc_match ("source )") == MATCH_YES) + { + c->depend_source = true; + continue; + } + else if (gfc_match ("sink : ") == MATCH_YES) + { + if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND]) + == MATCH_YES) + continue; + m = MATCH_NO; + } + else + m = MATCH_NO; + head = NULL; + if (m == MATCH_YES + && gfc_match_omp_variable_list (" : ", + &c->lists[OMP_LIST_DEPEND], + false, NULL, &head, + true) == MATCH_YES) + { + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + n->u.depend_op = depend_op; + continue; + } + else gfc_current_locus = old_loc; - break; - } - if (m == MATCH_NO) - needs_space = true; + } + if ((mask & OMP_CLAUSE_DEVICE) + && !openacc + && c->device == NULL + && gfc_match ("device ( %e )", &c->device) == MATCH_YES) continue; - } - if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL - && gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_FINAL) && c->final_expr == NULL - && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL - && gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_PRIVATE) - && gfc_match_omp_variable_list ("private (", - &c->lists[OMP_LIST_PRIVATE], true) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_FIRSTPRIVATE) - && gfc_match_omp_variable_list ("firstprivate (", - &c->lists[OMP_LIST_FIRSTPRIVATE], - true) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_LASTPRIVATE) - && gfc_match_omp_variable_list ("lastprivate (", - &c->lists[OMP_LIST_LASTPRIVATE], - true) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_COPYPRIVATE) - && gfc_match_omp_variable_list ("copyprivate (", - &c->lists[OMP_LIST_COPYPRIVATE], - true) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_SHARED) - && gfc_match_omp_variable_list ("shared (", - &c->lists[OMP_LIST_SHARED], true) - == MATCH_YES) - continue; - if (mask & OMP_CLAUSE_COPYIN) - { - if (openacc) + if ((mask & OMP_CLAUSE_DEVICE) + && openacc + && gfc_match ("device ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FORCE_TO)) + continue; + if ((mask & OMP_CLAUSE_DEVICEPTR) + && gfc_match ("deviceptr ( ") == MATCH_YES) + { + gfc_omp_namelist **list = &c->lists[OMP_LIST_MAP]; + gfc_omp_namelist **head = NULL; + if (gfc_match_omp_variable_list ("", list, true, NULL, + &head, false) == MATCH_YES) + { + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + n->u.map_op = OMP_MAP_FORCE_DEVICEPTR; + continue; + } + } + if ((mask & OMP_CLAUSE_DEVICE_RESIDENT) + && gfc_match_omp_variable_list + ("device_resident (", + &c->lists[OMP_LIST_DEVICE_RESIDENT], true) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_DIST_SCHEDULE) + && c->dist_sched_kind == OMP_SCHED_NONE + && gfc_match ("dist_schedule ( static") == MATCH_YES) { - if (gfc_match ("copyin ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_TO)) + match m = MATCH_NO; + c->dist_sched_kind = OMP_SCHED_STATIC; + m = gfc_match (" , %e )", &c->dist_chunk_size); + if (m != MATCH_YES) + m = gfc_match_char (')'); + if (m != MATCH_YES) + { + c->dist_sched_kind = OMP_SCHED_NONE; + gfc_current_locus = old_loc; + } + else continue; } - else if (gfc_match_omp_variable_list ("copyin (", - &c->lists[OMP_LIST_COPYIN], - true) == MATCH_YES) + break; + case 'f': + if ((mask & OMP_CLAUSE_FINAL) + && c->final_expr == NULL + && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES) continue; - } - if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL - && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL - && gfc_match ("num_workers ( %e )", &c->num_workers_expr) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_COPY) - && gfc_match ("copy ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_TOFROM)) - continue; - if ((mask & OMP_CLAUSE_COPYOUT) - && gfc_match ("copyout ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_FROM)) - continue; - if ((mask & OMP_CLAUSE_CREATE) - && gfc_match ("create ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_ALLOC)) - continue; - if ((mask & OMP_CLAUSE_DELETE) - && gfc_match ("delete ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_DELETE)) - continue; - if ((mask & OMP_CLAUSE_PRESENT) - && gfc_match ("present ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_PRESENT)) - continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) - && gfc_match ("present_or_copy ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TOFROM)) - continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) - && gfc_match ("pcopy ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TOFROM)) - continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN) - && gfc_match ("present_or_copyin ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TO)) - continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN) - && gfc_match ("pcopyin ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TO)) - continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT) - && gfc_match ("present_or_copyout ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FROM)) - continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT) - && gfc_match ("pcopyout ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FROM)) - continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE) - && gfc_match ("present_or_create ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_ALLOC)) - continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE) - && gfc_match ("pcreate ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_ALLOC)) - continue; - if ((mask & OMP_CLAUSE_DEVICEPTR) - && gfc_match ("deviceptr ( ") == MATCH_YES) - { - gfc_omp_namelist **list = &c->lists[OMP_LIST_MAP]; - gfc_omp_namelist **head = NULL; - if (gfc_match_omp_variable_list ("", list, true, NULL, &head, false) - == MATCH_YES) + if ((mask & OMP_CLAUSE_FIRSTPRIVATE) + && gfc_match_omp_variable_list ("firstprivate (", + &c->lists[OMP_LIST_FIRSTPRIVATE], + true) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_FROM) + && gfc_match_omp_variable_list ("from (", + &c->lists[OMP_LIST_FROM], false, + NULL, &head, true) == MATCH_YES) + continue; + break; + case 'g': + if ((mask & OMP_CLAUSE_GANG) + && !c->gang + && gfc_match ("gang") == MATCH_YES) { - gfc_omp_namelist *n; - for (n = *head; n; n = n->next) - n->u.map_op = OMP_MAP_FORCE_DEVICEPTR; + c->gang = true; + match m = match_oacc_clause_gwv (c, GOMP_DIM_GANG); + if (m == MATCH_ERROR) + { + gfc_current_locus = old_loc; + break; + } + else if (m == MATCH_NO) + needs_space = true; continue; } - } - if ((mask & OMP_CLAUSE_USE_DEVICE) - && gfc_match_omp_variable_list ("use_device (", - &c->lists[OMP_LIST_USE_DEVICE], true) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_DEVICE_RESIDENT) - && gfc_match_omp_variable_list ("device_resident (", - &c->lists[OMP_LIST_DEVICE_RESIDENT], - true) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_LINK) - && gfc_match_oacc_clause_link ("link (", - &c->lists[OMP_LIST_LINK]) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_OACC_DEVICE) - && gfc_match ("device ( ") == MATCH_YES - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_TO)) - continue; - if ((mask & OMP_CLAUSE_HOST_SELF) - && (gfc_match ("host ( ") == MATCH_YES - || gfc_match ("self ( ") == MATCH_YES) - && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_FROM)) - continue; - if ((mask & OMP_CLAUSE_TILE) - && !c->tile_list - && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_SEQ) && !c->seq - && gfc_match ("seq") == MATCH_YES) - { - c->seq = true; - needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent - && gfc_match ("independent") == MATCH_YES) - { - c->independent = true; - needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto - && gfc_match ("auto") == MATCH_YES) - { - c->par_auto = true; - needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_WAIT) && !c->wait - && gfc_match ("wait") == MATCH_YES) - { - c->wait = true; - match m = match_oacc_expr_list (" (", &c->wait_list, false); - if (m == MATCH_ERROR) + if ((mask & OMP_CLAUSE_GRAINSIZE) + && c->grainsize == NULL + && gfc_match ("grainsize ( %e )", &c->grainsize) == MATCH_YES) + continue; + break; + case 'h': + if ((mask & OMP_CLAUSE_HINT) + && c->hint == NULL + && gfc_match ("hint ( %e )", &c->hint) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_HOST_SELF) + && gfc_match ("host ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FORCE_FROM)) + continue; + break; + case 'i': + if ((mask & OMP_CLAUSE_IF) + && c->if_expr == NULL + && gfc_match ("if ( ") == MATCH_YES) { + if (gfc_match ("%e )", &c->if_expr) == MATCH_YES) + continue; + if (!openacc) + { + /* This should match the enum gfc_omp_if_kind order. */ + static const char *ifs[OMP_IF_LAST] = { + " parallel : %e )", + " task : %e )", + " taskloop : %e )", + " target : %e )", + " target data : %e )", + " target update : %e )", + " target enter data : %e )", + " target exit data : %e )" }; + int i; + for (i = 0; i < OMP_IF_LAST; i++) + if (c->if_exprs[i] == NULL + && gfc_match (ifs[i], &c->if_exprs[i]) == MATCH_YES) + break; + if (i < OMP_IF_LAST) + continue; + } gfc_current_locus = old_loc; - break; } - else if (m == MATCH_NO) - needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_REDUCTION) - && gfc_match ("reduction ( ") == MATCH_YES) - { - gfc_omp_reduction_op rop = OMP_REDUCTION_NONE; - char buffer[GFC_MAX_SYMBOL_LEN + 3]; - if (gfc_match_char ('+') == MATCH_YES) - rop = OMP_REDUCTION_PLUS; - else if (gfc_match_char ('*') == MATCH_YES) - rop = OMP_REDUCTION_TIMES; - else if (gfc_match_char ('-') == MATCH_YES) - rop = OMP_REDUCTION_MINUS; - else if (gfc_match (".and.") == MATCH_YES) - rop = OMP_REDUCTION_AND; - else if (gfc_match (".or.") == MATCH_YES) - rop = OMP_REDUCTION_OR; - else if (gfc_match (".eqv.") == MATCH_YES) - rop = OMP_REDUCTION_EQV; - else if (gfc_match (".neqv.") == MATCH_YES) - rop = OMP_REDUCTION_NEQV; - if (rop != OMP_REDUCTION_NONE) - snprintf (buffer, sizeof buffer, - "operator %s", gfc_op2string ((gfc_intrinsic_op) rop)); - else if (gfc_match_defined_op_name (buffer + 1, 1) == MATCH_YES) + if ((mask & OMP_CLAUSE_INBRANCH) + && !c->inbranch + && !c->notinbranch + && gfc_match ("inbranch") == MATCH_YES) { - buffer[0] = '.'; - strcat (buffer, "."); + c->inbranch = needs_space = true; + continue; } - else if (gfc_match_name (buffer) == MATCH_YES) + if ((mask & OMP_CLAUSE_INDEPENDENT) + && !c->independent + && gfc_match ("independent") == MATCH_YES) { - gfc_symbol *sym; - const char *n = buffer; - - gfc_find_symbol (buffer, NULL, 1, &sym); - if (sym != NULL) + c->independent = true; + needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_IS_DEVICE_PTR) + && gfc_match_omp_variable_list + ("is_device_ptr (", + &c->lists[OMP_LIST_IS_DEVICE_PTR], false) == MATCH_YES) + continue; + break; + case 'l': + if ((mask & OMP_CLAUSE_LASTPRIVATE) + && gfc_match_omp_variable_list ("lastprivate (", + &c->lists[OMP_LIST_LASTPRIVATE], + true) == MATCH_YES) + continue; + end_colon = false; + head = NULL; + if ((mask & OMP_CLAUSE_LINEAR) + && gfc_match ("linear (") == MATCH_YES) + { + gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT; + gfc_expr *step = NULL; + + if (gfc_match_omp_variable_list (" ref (", + &c->lists[OMP_LIST_LINEAR], + false, NULL, &head) + == MATCH_YES) + linear_op = OMP_LINEAR_REF; + else if (gfc_match_omp_variable_list (" val (", + &c->lists[OMP_LIST_LINEAR], + false, NULL, &head) + == MATCH_YES) + linear_op = OMP_LINEAR_VAL; + else if (gfc_match_omp_variable_list (" uval (", + &c->lists[OMP_LIST_LINEAR], + false, NULL, &head) + == MATCH_YES) + linear_op = OMP_LINEAR_UVAL; + else if (gfc_match_omp_variable_list ("", + &c->lists[OMP_LIST_LINEAR], + false, &end_colon, &head) + == MATCH_YES) + linear_op = OMP_LINEAR_DEFAULT; + else { - if (sym->attr.intrinsic) - n = sym->name; - else if ((sym->attr.flavor != FL_UNKNOWN - && sym->attr.flavor != FL_PROCEDURE) - || sym->attr.external - || sym->attr.generic - || sym->attr.entry - || sym->attr.result - || sym->attr.dummy - || sym->attr.subroutine - || sym->attr.pointer - || sym->attr.target - || sym->attr.cray_pointer - || sym->attr.cray_pointee - || (sym->attr.proc != PROC_UNKNOWN - && sym->attr.proc != PROC_INTRINSIC) - || sym->attr.if_source != IFSRC_UNKNOWN - || sym == sym->ns->proc_name) + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + if (linear_op != OMP_LINEAR_DEFAULT) + { + if (gfc_match (" :") == MATCH_YES) + end_colon = true; + else if (gfc_match (" )") != MATCH_YES) { - sym = NULL; - n = NULL; + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; } - else - n = sym->name; } - if (n == NULL) - rop = OMP_REDUCTION_NONE; - else if (strcmp (n, "max") == 0) - rop = OMP_REDUCTION_MAX; - else if (strcmp (n, "min") == 0) - rop = OMP_REDUCTION_MIN; - else if (strcmp (n, "iand") == 0) - rop = OMP_REDUCTION_IAND; - else if (strcmp (n, "ior") == 0) - rop = OMP_REDUCTION_IOR; - else if (strcmp (n, "ieor") == 0) - rop = OMP_REDUCTION_IEOR; - if (rop != OMP_REDUCTION_NONE - && sym != NULL - && ! sym->attr.intrinsic - && ! sym->attr.use_assoc - && ((sym->attr.flavor == FL_UNKNOWN - && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, - sym->name, NULL)) - || !gfc_add_intrinsic (&sym->attr, NULL))) - rop = OMP_REDUCTION_NONE; + if (end_colon && gfc_match (" %e )", &step) != MATCH_YES) + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + else if (!end_colon) + { + step = gfc_get_constant_expr (BT_INTEGER, + gfc_default_integer_kind, + &old_loc); + mpz_set_si (step->value.integer, 1); + } + (*head)->expr = step; + if (linear_op != OMP_LINEAR_DEFAULT) + for (gfc_omp_namelist *n = *head; n; n = n->next) + n->u.linear_op = linear_op; + continue; } - else - buffer[0] = '\0'; - gfc_omp_udr *udr - = (buffer[0] - ? gfc_find_omp_udr (gfc_current_ns, buffer, NULL) : NULL); - gfc_omp_namelist **head = NULL; - if (rop == OMP_REDUCTION_NONE && udr) - rop = OMP_REDUCTION_USER; - - if (gfc_match_omp_variable_list (" :", - &c->lists[OMP_LIST_REDUCTION], - false, NULL, &head, openacc) - == MATCH_YES) + if ((mask & OMP_CLAUSE_LINK) + && openacc + && (gfc_match_oacc_clause_link ("link (", + &c->lists[OMP_LIST_LINK]) + == MATCH_YES)) + continue; + else if ((mask & OMP_CLAUSE_LINK) + && !openacc + && (gfc_match_omp_to_link ("link (", + &c->lists[OMP_LIST_LINK]) + == MATCH_YES)) + continue; + break; + case 'm': + if ((mask & OMP_CLAUSE_MAP) + && gfc_match ("map ( ") == MATCH_YES) { - gfc_omp_namelist *n; - if (rop == OMP_REDUCTION_NONE) + locus old_loc2 = gfc_current_locus; + bool always = false; + gfc_omp_map_op map_op = OMP_MAP_TOFROM; + if (gfc_match ("always , ") == MATCH_YES) + always = true; + if (gfc_match ("alloc : ") == MATCH_YES) + map_op = OMP_MAP_ALLOC; + else if (gfc_match ("tofrom : ") == MATCH_YES) + map_op = always ? OMP_MAP_ALWAYS_TOFROM : OMP_MAP_TOFROM; + else if (gfc_match ("to : ") == MATCH_YES) + map_op = always ? OMP_MAP_ALWAYS_TO : OMP_MAP_TO; + else if (gfc_match ("from : ") == MATCH_YES) + map_op = always ? OMP_MAP_ALWAYS_FROM : OMP_MAP_FROM; + else if (gfc_match ("release : ") == MATCH_YES) + map_op = OMP_MAP_RELEASE; + else if (gfc_match ("delete : ") == MATCH_YES) + map_op = OMP_MAP_DELETE; + else if (always) { - n = *head; - *head = NULL; - gfc_error_now ("!$OMP DECLARE REDUCTION %s not found " - "at %L", buffer, &old_loc); - gfc_free_omp_namelist (n); + gfc_current_locus = old_loc2; + always = false; + } + head = NULL; + if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], + false, NULL, &head, + true) == MATCH_YES) + { + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + n->u.map_op = map_op; + continue; } else - for (n = *head; n; n = n->next) - { - n->u.reduction_op = rop; - if (udr) - { - n->udr = gfc_get_omp_namelist_udr (); - n->udr->udr = udr; - } - } + gfc_current_locus = old_loc; + } + if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable + && gfc_match ("mergeable") == MATCH_YES) + { + c->mergeable = needs_space = true; continue; } - else - gfc_current_locus = old_loc; - } - if ((mask & OMP_CLAUSE_DEFAULT) - && c->default_sharing == OMP_DEFAULT_UNKNOWN) - { - if (gfc_match ("default ( none )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_NONE; - else if (openacc) - /* c->default_sharing = OMP_DEFAULT_UNKNOWN */; - else if (gfc_match ("default ( shared )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_SHARED; - else if (gfc_match ("default ( private )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_PRIVATE; - else if (gfc_match ("default ( firstprivate )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE; - if (c->default_sharing != OMP_DEFAULT_UNKNOWN) + break; + case 'n': + if ((mask & OMP_CLAUSE_NOGROUP) + && !c->nogroup + && gfc_match ("nogroup") == MATCH_YES) + { + c->nogroup = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_NOTINBRANCH) + && !c->notinbranch + && !c->inbranch + && gfc_match ("notinbranch") == MATCH_YES) + { + c->notinbranch = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_NOWAIT) + && !c->nowait + && gfc_match ("nowait") == MATCH_YES) + { + c->nowait = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_NUM_GANGS) + && c->num_gangs_expr == NULL + && gfc_match ("num_gangs ( %e )", + &c->num_gangs_expr) == MATCH_YES) continue; - } - old_loc = gfc_current_locus; - if ((mask & OMP_CLAUSE_SCHEDULE) - && c->sched_kind == OMP_SCHED_NONE - && gfc_match ("schedule ( ") == MATCH_YES) - { - if (gfc_match ("static") == MATCH_YES) - c->sched_kind = OMP_SCHED_STATIC; - else if (gfc_match ("dynamic") == MATCH_YES) - c->sched_kind = OMP_SCHED_DYNAMIC; - else if (gfc_match ("guided") == MATCH_YES) - c->sched_kind = OMP_SCHED_GUIDED; - else if (gfc_match ("runtime") == MATCH_YES) - c->sched_kind = OMP_SCHED_RUNTIME; - else if (gfc_match ("auto") == MATCH_YES) - c->sched_kind = OMP_SCHED_AUTO; - if (c->sched_kind != OMP_SCHED_NONE) + if ((mask & OMP_CLAUSE_NUM_TASKS) + && c->num_tasks == NULL + && gfc_match ("num_tasks ( %e )", &c->num_tasks) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_NUM_TEAMS) + && c->num_teams == NULL + && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_NUM_THREADS) + && c->num_threads == NULL + && (gfc_match ("num_threads ( %e )", &c->num_threads) + == MATCH_YES)) + continue; + if ((mask & OMP_CLAUSE_NUM_WORKERS) + && c->num_workers_expr == NULL + && gfc_match ("num_workers ( %e )", + &c->num_workers_expr) == MATCH_YES) + continue; + break; + case 'o': + if ((mask & OMP_CLAUSE_ORDERED) + && !c->ordered + && gfc_match ("ordered") == MATCH_YES) { - match m = MATCH_NO; - if (c->sched_kind != OMP_SCHED_RUNTIME - && c->sched_kind != OMP_SCHED_AUTO) - m = gfc_match (" , %e )", &c->chunk_size); - if (m != MATCH_YES) - m = gfc_match_char (')'); - if (m != MATCH_YES) - c->sched_kind = OMP_SCHED_NONE; + gfc_expr *cexpr = NULL; + match m = gfc_match (" ( %e )", &cexpr); + + c->ordered = true; + if (m == MATCH_YES) + { + int ordered = 0; + if (gfc_extract_int (cexpr, &ordered, -1)) + ordered = 0; + else if (ordered <= 0) + { + gfc_error_now ("ORDERED clause argument not" + " constant positive integer at %C"); + ordered = 0; + } + c->orderedc = ordered; + gfc_free_expr (cexpr); + continue; + } + + needs_space = true; + continue; } - if (c->sched_kind != OMP_SCHED_NONE) + break; + case 'p': + if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) + && gfc_match ("pcopy ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_TOFROM)) continue; - else - gfc_current_locus = old_loc; - } - if ((mask & OMP_CLAUSE_ORDERED) && !c->ordered - && gfc_match ("ordered") == MATCH_YES) - { - c->ordered = needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_UNTIED) && !c->untied - && gfc_match ("untied") == MATCH_YES) - { - c->untied = needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable - && gfc_match ("mergeable") == MATCH_YES) - { - c->mergeable = needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_COLLAPSE) && !c->collapse) - { - gfc_expr *cexpr = NULL; - match m = gfc_match ("collapse ( %e )", &cexpr); + if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN) + && gfc_match ("pcopyin ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_TO)) + continue; + if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT) + && gfc_match ("pcopyout ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FROM)) + continue; + if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE) + && gfc_match ("pcreate ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_ALLOC)) + continue; + if ((mask & OMP_CLAUSE_PRESENT) + && gfc_match ("present ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FORCE_PRESENT)) + continue; + if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) + && gfc_match ("present_or_copy ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_TOFROM)) + continue; + if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN) + && gfc_match ("present_or_copyin ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_TO)) + continue; + if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT) + && gfc_match ("present_or_copyout ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FROM)) + continue; + if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE) + && gfc_match ("present_or_create ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_ALLOC)) + continue; + if ((mask & OMP_CLAUSE_PRIORITY) + && c->priority == NULL + && gfc_match ("priority ( %e )", &c->priority) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_PRIVATE) + && gfc_match_omp_variable_list ("private (", + &c->lists[OMP_LIST_PRIVATE], + true) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_PROC_BIND) + && c->proc_bind == OMP_PROC_BIND_UNKNOWN) + { + if (gfc_match ("proc_bind ( master )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_MASTER; + else if (gfc_match ("proc_bind ( spread )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_SPREAD; + else if (gfc_match ("proc_bind ( close )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_CLOSE; + if (c->proc_bind != OMP_PROC_BIND_UNKNOWN) + continue; + } + break; + case 'r': + if ((mask & OMP_CLAUSE_REDUCTION) + && gfc_match ("reduction ( ") == MATCH_YES) + { + gfc_omp_reduction_op rop = OMP_REDUCTION_NONE; + char buffer[GFC_MAX_SYMBOL_LEN + 3]; + if (gfc_match_char ('+') == MATCH_YES) + rop = OMP_REDUCTION_PLUS; + else if (gfc_match_char ('*') == MATCH_YES) + rop = OMP_REDUCTION_TIMES; + else if (gfc_match_char ('-') == MATCH_YES) + rop = OMP_REDUCTION_MINUS; + else if (gfc_match (".and.") == MATCH_YES) + rop = OMP_REDUCTION_AND; + else if (gfc_match (".or.") == MATCH_YES) + rop = OMP_REDUCTION_OR; + else if (gfc_match (".eqv.") == MATCH_YES) + rop = OMP_REDUCTION_EQV; + else if (gfc_match (".neqv.") == MATCH_YES) + rop = OMP_REDUCTION_NEQV; + if (rop != OMP_REDUCTION_NONE) + snprintf (buffer, sizeof buffer, "operator %s", + gfc_op2string ((gfc_intrinsic_op) rop)); + else if (gfc_match_defined_op_name (buffer + 1, 1) == MATCH_YES) + { + buffer[0] = '.'; + strcat (buffer, "."); + } + else if (gfc_match_name (buffer) == MATCH_YES) + { + gfc_symbol *sym; + const char *n = buffer; - if (m == MATCH_YES) + gfc_find_symbol (buffer, NULL, 1, &sym); + if (sym != NULL) + { + if (sym->attr.intrinsic) + n = sym->name; + else if ((sym->attr.flavor != FL_UNKNOWN + && sym->attr.flavor != FL_PROCEDURE) + || sym->attr.external + || sym->attr.generic + || sym->attr.entry + || sym->attr.result + || sym->attr.dummy + || sym->attr.subroutine + || sym->attr.pointer + || sym->attr.target + || sym->attr.cray_pointer + || sym->attr.cray_pointee + || (sym->attr.proc != PROC_UNKNOWN + && sym->attr.proc != PROC_INTRINSIC) + || sym->attr.if_source != IFSRC_UNKNOWN + || sym == sym->ns->proc_name) + { + sym = NULL; + n = NULL; + } + else + n = sym->name; + } + if (n == NULL) + rop = OMP_REDUCTION_NONE; + else if (strcmp (n, "max") == 0) + rop = OMP_REDUCTION_MAX; + else if (strcmp (n, "min") == 0) + rop = OMP_REDUCTION_MIN; + else if (strcmp (n, "iand") == 0) + rop = OMP_REDUCTION_IAND; + else if (strcmp (n, "ior") == 0) + rop = OMP_REDUCTION_IOR; + else if (strcmp (n, "ieor") == 0) + rop = OMP_REDUCTION_IEOR; + if (rop != OMP_REDUCTION_NONE + && sym != NULL + && ! sym->attr.intrinsic + && ! sym->attr.use_assoc + && ((sym->attr.flavor == FL_UNKNOWN + && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, + sym->name, NULL)) + || !gfc_add_intrinsic (&sym->attr, NULL))) + rop = OMP_REDUCTION_NONE; + } + else + buffer[0] = '\0'; + gfc_omp_udr *udr + = (buffer[0] + ? gfc_find_omp_udr (gfc_current_ns, buffer, NULL) : NULL); + gfc_omp_namelist **head = NULL; + if (rop == OMP_REDUCTION_NONE && udr) + rop = OMP_REDUCTION_USER; + + if (gfc_match_omp_variable_list (" :", + &c->lists[OMP_LIST_REDUCTION], + false, NULL, &head, + openacc) == MATCH_YES) + { + gfc_omp_namelist *n; + if (rop == OMP_REDUCTION_NONE) + { + n = *head; + *head = NULL; + gfc_error_now ("!$OMP DECLARE REDUCTION %s not found " + "at %L", buffer, &old_loc); + gfc_free_omp_namelist (n); + } + else + for (n = *head; n; n = n->next) + { + n->u.reduction_op = rop; + if (udr) + { + n->udr = gfc_get_omp_namelist_udr (); + n->udr->udr = udr; + } + } + continue; + } + else + gfc_current_locus = old_loc; + } + break; + case 's': + if ((mask & OMP_CLAUSE_SAFELEN) + && c->safelen_expr == NULL + && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_SCHEDULE) + && c->sched_kind == OMP_SCHED_NONE + && gfc_match ("schedule ( ") == MATCH_YES) { - int collapse; - const char *p = gfc_extract_int (cexpr, &collapse); - if (p) + int nmodifiers = 0; + locus old_loc2 = gfc_current_locus; + do { - gfc_error_now (p); - collapse = 1; + if (!c->sched_simd + && gfc_match ("simd") == MATCH_YES) + { + c->sched_simd = true; + nmodifiers++; + } + else if (!c->sched_monotonic + && !c->sched_nonmonotonic + && gfc_match ("monotonic") == MATCH_YES) + { + c->sched_monotonic = true; + nmodifiers++; + } + else if (!c->sched_monotonic + && !c->sched_nonmonotonic + && gfc_match ("nonmonotonic") == MATCH_YES) + { + c->sched_nonmonotonic = true; + nmodifiers++; + } + else + { + if (nmodifiers) + gfc_current_locus = old_loc2; + break; + } + if (nmodifiers == 0 + && gfc_match (" , ") == MATCH_YES) + continue; + else if (gfc_match (" : ") == MATCH_YES) + break; + gfc_current_locus = old_loc2; + break; } - else if (collapse <= 0) + while (1); + if (gfc_match ("static") == MATCH_YES) + c->sched_kind = OMP_SCHED_STATIC; + else if (gfc_match ("dynamic") == MATCH_YES) + c->sched_kind = OMP_SCHED_DYNAMIC; + else if (gfc_match ("guided") == MATCH_YES) + c->sched_kind = OMP_SCHED_GUIDED; + else if (gfc_match ("runtime") == MATCH_YES) + c->sched_kind = OMP_SCHED_RUNTIME; + else if (gfc_match ("auto") == MATCH_YES) + c->sched_kind = OMP_SCHED_AUTO; + if (c->sched_kind != OMP_SCHED_NONE) { - gfc_error_now ("COLLAPSE clause argument not" - " constant positive integer at %C"); - collapse = 1; + match m = MATCH_NO; + if (c->sched_kind != OMP_SCHED_RUNTIME + && c->sched_kind != OMP_SCHED_AUTO) + m = gfc_match (" , %e )", &c->chunk_size); + if (m != MATCH_YES) + m = gfc_match_char (')'); + if (m != MATCH_YES) + c->sched_kind = OMP_SCHED_NONE; } - c->collapse = collapse; - gfc_free_expr (cexpr); + if (c->sched_kind != OMP_SCHED_NONE) + continue; + else + gfc_current_locus = old_loc; + } + if ((mask & OMP_CLAUSE_HOST_SELF) + && gfc_match ("self ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FORCE_FROM)) + continue; + if ((mask & OMP_CLAUSE_SEQ) + && !c->seq + && gfc_match ("seq") == MATCH_YES) + { + c->seq = true; + needs_space = true; continue; } - } - if ((mask & OMP_CLAUSE_INBRANCH) && !c->inbranch && !c->notinbranch - && gfc_match ("inbranch") == MATCH_YES) - { - c->inbranch = needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_NOTINBRANCH) && !c->notinbranch && !c->inbranch - && gfc_match ("notinbranch") == MATCH_YES) - { - c->notinbranch = needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_PROC_BIND) - && c->proc_bind == OMP_PROC_BIND_UNKNOWN) - { - if (gfc_match ("proc_bind ( master )") == MATCH_YES) - c->proc_bind = OMP_PROC_BIND_MASTER; - else if (gfc_match ("proc_bind ( spread )") == MATCH_YES) - c->proc_bind = OMP_PROC_BIND_SPREAD; - else if (gfc_match ("proc_bind ( close )") == MATCH_YES) - c->proc_bind = OMP_PROC_BIND_CLOSE; - if (c->proc_bind != OMP_PROC_BIND_UNKNOWN) + if ((mask & OMP_CLAUSE_SHARED) + && gfc_match_omp_variable_list ("shared (", + &c->lists[OMP_LIST_SHARED], + true) == MATCH_YES) continue; - } - if ((mask & OMP_CLAUSE_SAFELEN) && c->safelen_expr == NULL - && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_SIMDLEN) && c->simdlen_expr == NULL - && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_UNIFORM) - && gfc_match_omp_variable_list ("uniform (", - &c->lists[OMP_LIST_UNIFORM], false) - == MATCH_YES) - continue; - bool end_colon = false; - gfc_omp_namelist **head = NULL; - old_loc = gfc_current_locus; - if ((mask & OMP_CLAUSE_ALIGNED) - && gfc_match_omp_variable_list ("aligned (", - &c->lists[OMP_LIST_ALIGNED], false, - &end_colon, &head) - == MATCH_YES) - { - gfc_expr *alignment = NULL; - gfc_omp_namelist *n; - - if (end_colon - && gfc_match (" %e )", &alignment) != MATCH_YES) + if ((mask & OMP_CLAUSE_SIMDLEN) + && c->simdlen_expr == NULL + && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_SIMD) + && !c->simd + && gfc_match ("simd") == MATCH_YES) { - gfc_free_omp_namelist (*head); - gfc_current_locus = old_loc; - *head = NULL; - break; + c->simd = needs_space = true; + continue; } - for (n = *head; n; n = n->next) - if (n->next && alignment) - n->expr = gfc_copy_expr (alignment); - else - n->expr = alignment; - continue; - } - end_colon = false; - head = NULL; - old_loc = gfc_current_locus; - if ((mask & OMP_CLAUSE_LINEAR) - && gfc_match_omp_variable_list ("linear (", - &c->lists[OMP_LIST_LINEAR], false, - &end_colon, &head) - == MATCH_YES) - { - gfc_expr *step = NULL; - - if (end_colon - && gfc_match (" %e )", &step) != MATCH_YES) + break; + case 't': + if ((mask & OMP_CLAUSE_THREAD_LIMIT) + && c->thread_limit == NULL + && gfc_match ("thread_limit ( %e )", + &c->thread_limit) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_THREADS) + && !c->threads + && gfc_match ("threads") == MATCH_YES) { - gfc_free_omp_namelist (*head); - gfc_current_locus = old_loc; - *head = NULL; - break; + c->threads = needs_space = true; + continue; } - else if (!end_colon) + if ((mask & OMP_CLAUSE_TILE) + && !c->tile_list + && match_oacc_expr_list ("tile (", &c->tile_list, + true) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_TO) && (mask & OMP_CLAUSE_LINK)) { - step = gfc_get_constant_expr (BT_INTEGER, - gfc_default_integer_kind, - &old_loc); - mpz_set_si (step->value.integer, 1); + if (gfc_match_omp_to_link ("to (", &c->lists[OMP_LIST_TO]) + == MATCH_YES) + continue; } - (*head)->expr = step; - continue; - } - if ((mask & OMP_CLAUSE_DEPEND) - && gfc_match ("depend ( ") == MATCH_YES) - { - match m = MATCH_YES; - gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; - if (gfc_match ("inout") == MATCH_YES) - depend_op = OMP_DEPEND_INOUT; - else if (gfc_match ("in") == MATCH_YES) - depend_op = OMP_DEPEND_IN; - else if (gfc_match ("out") == MATCH_YES) - depend_op = OMP_DEPEND_OUT; - else - m = MATCH_NO; - head = NULL; - if (m == MATCH_YES - && gfc_match_omp_variable_list (" : ", - &c->lists[OMP_LIST_DEPEND], - false, NULL, &head, true) - == MATCH_YES) + else if ((mask & OMP_CLAUSE_TO) + && gfc_match_omp_variable_list ("to (", + &c->lists[OMP_LIST_TO], false, + NULL, &head, true) == MATCH_YES) + continue; + break; + case 'u': + if ((mask & OMP_CLAUSE_UNIFORM) + && gfc_match_omp_variable_list ("uniform (", + &c->lists[OMP_LIST_UNIFORM], + false) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_UNTIED) + && !c->untied + && gfc_match ("untied") == MATCH_YES) { - gfc_omp_namelist *n; - for (n = *head; n; n = n->next) - n->u.depend_op = depend_op; + c->untied = needs_space = true; continue; } - else - gfc_current_locus = old_loc; - } - if ((mask & OMP_CLAUSE_DIST_SCHEDULE) - && c->dist_sched_kind == OMP_SCHED_NONE - && gfc_match ("dist_schedule ( static") == MATCH_YES) - { - match m = MATCH_NO; - c->dist_sched_kind = OMP_SCHED_STATIC; - m = gfc_match (" , %e )", &c->dist_chunk_size); - if (m != MATCH_YES) - m = gfc_match_char (')'); - if (m != MATCH_YES) + if ((mask & OMP_CLAUSE_USE_DEVICE) + && gfc_match_omp_variable_list ("use_device (", + &c->lists[OMP_LIST_USE_DEVICE], + true) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_USE_DEVICE_PTR) + && gfc_match_omp_variable_list + ("use_device_ptr (", + &c->lists[OMP_LIST_USE_DEVICE_PTR], false) == MATCH_YES) + continue; + break; + case 'v': + /* VECTOR_LENGTH must be matched before VECTOR, because the latter + doesn't unconditionally match '('. */ + if ((mask & OMP_CLAUSE_VECTOR_LENGTH) + && c->vector_length_expr == NULL + && (gfc_match ("vector_length ( %e )", &c->vector_length_expr) + == MATCH_YES)) + continue; + if ((mask & OMP_CLAUSE_VECTOR) + && !c->vector + && gfc_match ("vector") == MATCH_YES) { - c->dist_sched_kind = OMP_SCHED_NONE; - gfc_current_locus = old_loc; + c->vector = true; + match m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR); + if (m == MATCH_ERROR) + { + gfc_current_locus = old_loc; + break; + } + if (m == MATCH_NO) + needs_space = true; + continue; } - else - continue; - } - if ((mask & OMP_CLAUSE_NUM_TEAMS) && c->num_teams == NULL - && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_DEVICE) && c->device == NULL - && gfc_match ("device ( %e )", &c->device) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_THREAD_LIMIT) && c->thread_limit == NULL - && gfc_match ("thread_limit ( %e )", &c->thread_limit) == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_MAP) - && gfc_match ("map ( ") == MATCH_YES) - { - gfc_omp_map_op map_op = OMP_MAP_TOFROM; - if (gfc_match ("alloc : ") == MATCH_YES) - map_op = OMP_MAP_ALLOC; - else if (gfc_match ("tofrom : ") == MATCH_YES) - map_op = OMP_MAP_TOFROM; - else if (gfc_match ("to : ") == MATCH_YES) - map_op = OMP_MAP_TO; - else if (gfc_match ("from : ") == MATCH_YES) - map_op = OMP_MAP_FROM; - head = NULL; - if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], - false, NULL, &head, true) - == MATCH_YES) + break; + case 'w': + if ((mask & OMP_CLAUSE_WAIT) + && !c->wait + && gfc_match ("wait") == MATCH_YES) { - gfc_omp_namelist *n; - for (n = *head; n; n = n->next) - n->u.map_op = map_op; + c->wait = true; + match m = match_oacc_expr_list (" (", &c->wait_list, false); + if (m == MATCH_ERROR) + { + gfc_current_locus = old_loc; + break; + } + else if (m == MATCH_NO) + needs_space = true; continue; } - else - gfc_current_locus = old_loc; + if ((mask & OMP_CLAUSE_WORKER) + && !c->worker + && gfc_match ("worker") == MATCH_YES) + { + c->worker = true; + match m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER); + if (m == MATCH_ERROR) + { + gfc_current_locus = old_loc; + break; + } + else if (m == MATCH_NO) + needs_space = true; + continue; + } + break; } - if ((mask & OMP_CLAUSE_TO) - && gfc_match_omp_variable_list ("to (", - &c->lists[OMP_LIST_TO], false, - NULL, &head, true) - == MATCH_YES) - continue; - if ((mask & OMP_CLAUSE_FROM) - && gfc_match_omp_variable_list ("from (", - &c->lists[OMP_LIST_FROM], false, - NULL, &head, true) - == MATCH_YES) - continue; - break; } @@ -1343,152 +1918,115 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, #define OACC_PARALLEL_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \ - | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ + | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ + | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE \ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT) #define OACC_KERNELS_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \ - | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \ + | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ + | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT) #define OACC_DATA_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \ - | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \ - | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \ + | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \ + | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ + | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ | OMP_CLAUSE_PRESENT_OR_CREATE) #define OACC_LOOP_CLAUSES \ - (OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \ - | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \ - | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \ + (omp_mask (OMP_CLAUSE_COLLAPSE) | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \ + | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \ + | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \ | OMP_CLAUSE_TILE) #define OACC_PARALLEL_LOOP_CLAUSES \ (OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES) #define OACC_KERNELS_LOOP_CLAUSES \ (OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES) -#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE +#define OACC_HOST_DATA_CLAUSES omp_mask (OMP_CLAUSE_USE_DEVICE) #define OACC_DECLARE_CLAUSES \ - (OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ + (omp_mask (OMP_CLAUSE_COPY) | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \ - | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ + | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ + | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_LINK) #define OACC_UPDATE_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \ - | OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_WAIT) + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \ + | OMP_CLAUSE_DEVICE | OMP_CLAUSE_WAIT) #define OACC_ENTER_DATA_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYIN \ - | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT \ + | OMP_CLAUSE_COPYIN | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \ | OMP_CLAUSE_PRESENT_OR_CREATE) #define OACC_EXIT_DATA_CLAUSES \ - (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYOUT \ - | OMP_CLAUSE_DELETE) + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT \ + | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_DELETE) #define OACC_WAIT_CLAUSES \ - (OMP_CLAUSE_ASYNC) + omp_mask (OMP_CLAUSE_ASYNC) #define OACC_ROUTINE_CLAUSES \ - (OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ) + (omp_mask (OMP_CLAUSE_GANG) | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR \ + | OMP_CLAUSE_SEQ) -match -gfc_match_oacc_parallel_loop (void) +static match +match_acc (gfc_exec_op op, const omp_mask mask) { gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES, false, false, - true) != MATCH_YES) + if (gfc_match_omp_clauses (&c, mask, false, false, true) != MATCH_YES) return MATCH_ERROR; - - new_st.op = EXEC_OACC_PARALLEL_LOOP; + new_st.op = op; new_st.ext.omp_clauses = c; return MATCH_YES; } +match +gfc_match_oacc_parallel_loop (void) +{ + return match_acc (EXEC_OACC_PARALLEL_LOOP, OACC_PARALLEL_LOOP_CLAUSES); +} + match gfc_match_oacc_parallel (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES, false, false, true) - != MATCH_YES) - return MATCH_ERROR; - - new_st.op = EXEC_OACC_PARALLEL; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_acc (EXEC_OACC_PARALLEL, OACC_PARALLEL_CLAUSES); } match gfc_match_oacc_kernels_loop (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES, false, false, - true) != MATCH_YES) - return MATCH_ERROR; - - new_st.op = EXEC_OACC_KERNELS_LOOP; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_acc (EXEC_OACC_KERNELS_LOOP, OACC_KERNELS_LOOP_CLAUSES); } match gfc_match_oacc_kernels (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES, false, false, true) - != MATCH_YES) - return MATCH_ERROR; - - new_st.op = EXEC_OACC_KERNELS; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_acc (EXEC_OACC_KERNELS, OACC_KERNELS_CLAUSES); } match gfc_match_oacc_data (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES, false, false, true) - != MATCH_YES) - return MATCH_ERROR; - - new_st.op = EXEC_OACC_DATA; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_acc (EXEC_OACC_DATA, OACC_DATA_CLAUSES); } match gfc_match_oacc_host_data (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES, false, false, true) - != MATCH_YES) - return MATCH_ERROR; - - new_st.op = EXEC_OACC_HOST_DATA; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_acc (EXEC_OACC_HOST_DATA, OACC_HOST_DATA_CLAUSES); } match gfc_match_oacc_loop (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES, false, false, true) - != MATCH_YES) - return MATCH_ERROR; - - new_st.op = EXEC_OACC_LOOP; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_acc (EXEC_OACC_LOOP, OACC_LOOP_CLAUSES); } @@ -1521,7 +2059,7 @@ gfc_match_oacc_declare (void) if (n->u.map_op != OMP_MAP_FORCE_ALLOC && n->u.map_op != OMP_MAP_FORCE_TO) { - gfc_error ("Invalid clause in module with $!ACC DECLARE at %L", + gfc_error ("Invalid clause in module with !$ACC DECLARE at %L", &where); return MATCH_ERROR; } @@ -1531,7 +2069,7 @@ gfc_match_oacc_declare (void) if (s->attr.use_assoc) { - gfc_error ("Variable is USE-associated with $!ACC DECLARE at %L", + gfc_error ("Variable is USE-associated with !$ACC DECLARE at %L", &where); return MATCH_ERROR; } @@ -1539,7 +2077,7 @@ gfc_match_oacc_declare (void) if ((s->attr.dimension || s->attr.codimension) && s->attr.dummy && s->as->type != AS_EXPLICIT) { - gfc_error ("Assumed-size dummy array with $!ACC DECLARE at %L", + gfc_error ("Assumed-size dummy array with !$ACC DECLARE at %L", &where); return MATCH_ERROR; } @@ -1600,28 +2138,14 @@ gfc_match_oacc_update (void) match gfc_match_oacc_enter_data (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES, false, false, true) - != MATCH_YES) - return MATCH_ERROR; - - new_st.op = EXEC_OACC_ENTER_DATA; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_acc (EXEC_OACC_ENTER_DATA, OACC_ENTER_DATA_CLAUSES); } match gfc_match_oacc_exit_data (void) { - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES, false, false, true) - != MATCH_YES) - return MATCH_ERROR; - - new_st.op = EXEC_OACC_EXIT_DATA; - new_st.ext.omp_clauses = c; - return MATCH_YES; + return match_acc (EXEC_OACC_EXIT_DATA, OACC_EXIT_DATA_CLAUSES); } @@ -1648,7 +2172,7 @@ gfc_match_oacc_wait (void) { if (el->expr == NULL) { - gfc_error ("Invalid argument to $!ACC WAIT at %L", + gfc_error ("Invalid argument to !$ACC WAIT at %L", &wait_list->expr->where); return MATCH_ERROR; } @@ -1839,44 +2363,71 @@ cleanup: #define OMP_PARALLEL_CLAUSES \ - (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_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) #define OMP_DECLARE_SIMD_CLAUSES \ - (OMP_CLAUSE_SIMDLEN | OMP_CLAUSE_LINEAR | OMP_CLAUSE_UNIFORM \ - | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH | OMP_CLAUSE_NOTINBRANCH) + (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \ + | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \ + | OMP_CLAUSE_NOTINBRANCH) #define OMP_DO_CLAUSES \ - (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ + (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_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \ + | OMP_CLAUSE_LINEAR) #define OMP_SECTIONS_CLAUSES \ - (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) #define OMP_SIMD_CLAUSES \ - (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ - | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN | OMP_CLAUSE_LINEAR \ - | OMP_CLAUSE_ALIGNED) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \ + | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \ + | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_SIMDLEN) #define OMP_TASK_CLAUSES \ - (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ - | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \ - | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_DEPEND) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \ + | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \ + | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY) +#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) #define OMP_TARGET_CLAUSES \ - (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF) + (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) #define OMP_TARGET_DATA_CLAUSES \ - (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF) + (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ + | OMP_CLAUSE_USE_DEVICE_PTR) +#define OMP_TARGET_ENTER_DATA_CLAUSES \ + (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ + | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT) +#define OMP_TARGET_EXIT_DATA_CLAUSES \ + (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ + | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT) #define OMP_TARGET_UPDATE_CLAUSES \ - (OMP_CLAUSE_DEVICE | OMP_CLAUSE_IF | OMP_CLAUSE_TO | OMP_CLAUSE_FROM) + (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_IF | OMP_CLAUSE_TO \ + | OMP_CLAUSE_FROM | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT) #define OMP_TEAMS_CLAUSES \ - (OMP_CLAUSE_NUM_TEAMS | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ - | OMP_CLAUSE_REDUCTION) + (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) #define OMP_DISTRIBUTE_CLAUSES \ - (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_COLLAPSE \ - | OMP_CLAUSE_DIST_SCHEDULE) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE) +#define OMP_SINGLE_CLAUSES \ + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) +#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) static match -match_omp (gfc_exec_op op, unsigned int mask) +match_omp (gfc_exec_op op, const omp_mask mask) { gfc_omp_clauses *c; if (gfc_match_omp_clauses (&c, mask) != MATCH_YES) @@ -1891,6 +2442,32 @@ match gfc_match_omp_critical (void) { char n[GFC_MAX_SYMBOL_LEN+1]; + gfc_omp_clauses *c = NULL; + + if (gfc_match (" ( %n )", n) != MATCH_YES) + { + n[0] = '\0'; + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); + return MATCH_ERROR; + } + } + else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_HINT)) != MATCH_YES) + return MATCH_ERROR; + + new_st.op = EXEC_OMP_CRITICAL; + new_st.ext.omp_clauses = c; + if (n[0]) + c->critical_name = xstrdup (n); + return MATCH_YES; +} + + +match +gfc_match_omp_end_critical (void) +{ + char n[GFC_MAX_SYMBOL_LEN+1]; if (gfc_match (" ( %n )", n) != MATCH_YES) n[0] = '\0'; @@ -1899,7 +2476,8 @@ gfc_match_omp_critical (void) gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); return MATCH_ERROR; } - new_st.op = EXEC_OMP_CRITICAL; + + new_st.op = EXEC_OMP_END_CRITICAL; new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL; return MATCH_YES; } @@ -1916,8 +2494,10 @@ match gfc_match_omp_distribute_parallel_do (void) { return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO, - OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES - | OMP_DO_CLAUSES); + (OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_ORDERED)) + & ~(omp_mask (OMP_CLAUSE_LINEAR))); } @@ -1927,7 +2507,7 @@ gfc_match_omp_distribute_parallel_do_simd (void) return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, (OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) - & ~OMP_CLAUSE_ORDERED); + & ~(omp_mask (OMP_CLAUSE_ORDERED))); } @@ -1949,8 +2529,7 @@ gfc_match_omp_do (void) match gfc_match_omp_do_simd (void) { - return match_omp (EXEC_OMP_DO_SIMD, ((OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) - & ~OMP_CLAUSE_ORDERED)); + return match_omp (EXEC_OMP_DO_SIMD, OMP_DO_CLAUSES | OMP_SIMD_CLAUSES); } @@ -1978,14 +2557,25 @@ gfc_match_omp_declare_simd (void) gfc_symbol *proc_name; gfc_omp_clauses *c; gfc_omp_declare_simd *ods; + bool needs_space = false; - if (gfc_match (" ( %s ) ", &proc_name) != MATCH_YES) - return MATCH_ERROR; + switch (gfc_match (" ( %s ) ", &proc_name)) + { + case MATCH_YES: break; + case MATCH_NO: proc_name = NULL; needs_space = true; break; + case MATCH_ERROR: return MATCH_ERROR; + } if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true, - false) != MATCH_YES) + needs_space) != MATCH_YES) return MATCH_ERROR; + if (gfc_current_ns->is_block_data) + { + gfc_free_omp_clauses (c); + return MATCH_YES; + } + ods = gfc_get_omp_declare_simd (); ods->where = where; ods->proc_name = proc_name; @@ -2268,7 +2858,7 @@ gfc_match_omp_declare_reduction (void) const char *predef_name = NULL; omp_udr = gfc_get_omp_udr (); - omp_udr->name = gfc_get_string (name); + omp_udr->name = gfc_get_string ("%s", name); omp_udr->rop = rop; omp_udr->ts = tss[i]; omp_udr->where = where; @@ -2391,26 +2981,15 @@ match gfc_match_omp_declare_target (void) { locus old_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; - gfc_symbol *sym; match m; - gfc_symtree *st; + gfc_omp_clauses *c = NULL; + int list; + gfc_omp_namelist *n; + gfc_symbol *s; old_loc = gfc_current_locus; - m = gfc_match (" ("); - if (gfc_current_ns->proc_name - && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY - && m == MATCH_YES) - { - gfc_error ("Only the !$OMP DECLARE TARGET form without " - "list is allowed in interface block at %C"); - goto cleanup; - } - - if (m == MATCH_NO - && gfc_current_ns->proc_name && gfc_match_omp_eos () == MATCH_YES) { if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr, @@ -2420,58 +2999,111 @@ gfc_match_omp_declare_target (void) return MATCH_YES; } - if (m != MATCH_YES) - return m; + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY) + { + gfc_error ("Only the !$OMP DECLARE TARGET form without " + "clauses is allowed in interface block at %C"); + goto cleanup; + } - for (;;) + m = gfc_match (" ("); + if (m == MATCH_YES) { - m = gfc_match_symbol (&sym, 0); - switch (m) + c = gfc_get_omp_clauses (); + gfc_current_locus = old_loc; + m = gfc_match_omp_to_link (" (", &c->lists[OMP_LIST_TO]); + if (m != MATCH_YES) + goto syntax; + if (gfc_match_omp_eos () != MATCH_YES) { - case MATCH_YES: - if (sym->attr.in_common) - gfc_error_now ("OMP DECLARE TARGET on a variable at %C is an " - "element of a COMMON block"); - else if (!gfc_add_omp_declare_target (&sym->attr, sym->name, - &sym->declared_at)) - goto cleanup; - goto next_item; - case MATCH_NO: - break; - case MATCH_ERROR: + gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C"); goto cleanup; } + } + else if (gfc_match_omp_clauses (&c, OMP_DECLARE_TARGET_CLAUSES) != MATCH_YES) + return MATCH_ERROR; - m = gfc_match (" / %n /", n); - if (m == MATCH_ERROR) - goto cleanup; - if (m == MATCH_NO || n[0] == '\0') - goto syntax; + gfc_buffer_error (false); - st = gfc_find_symtree (gfc_current_ns->common_root, n); - if (st == NULL) + for (list = OMP_LIST_TO; list != OMP_LIST_NUM; + list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM)) + for (n = c->lists[list]; n; n = n->next) + if (n->sym) + n->sym->mark = 0; + else if (n->u.common->head) + n->u.common->head->mark = 0; + + for (list = OMP_LIST_TO; list != OMP_LIST_NUM; + list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM)) + for (n = c->lists[list]; n; n = n->next) + if (n->sym) { - gfc_error ("COMMON block /%s/ not found at %C", n); - goto cleanup; + if (n->sym->attr.in_common) + gfc_error_now ("OMP DECLARE TARGET variable at %L is an " + "element of a COMMON block", &n->where); + else if (n->sym->attr.omp_declare_target + && n->sym->attr.omp_declare_target_link + && list != OMP_LIST_LINK) + gfc_error_now ("OMP DECLARE TARGET variable at %L previously " + "mentioned in LINK clause and later in TO clause", + &n->where); + else if (n->sym->attr.omp_declare_target + && !n->sym->attr.omp_declare_target_link + && list == OMP_LIST_LINK) + gfc_error_now ("OMP DECLARE TARGET variable at %L previously " + "mentioned in TO clause and later in LINK clause", + &n->where); + else if (n->sym->mark) + gfc_error_now ("Variable at %L mentioned multiple times in " + "clauses of the same OMP DECLARE TARGET directive", + &n->where); + else if (gfc_add_omp_declare_target (&n->sym->attr, n->sym->name, + &n->sym->declared_at)) + { + if (list == OMP_LIST_LINK) + gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name, + &n->sym->declared_at); + } + n->sym->mark = 1; + } + else if (n->u.common->omp_declare_target + && n->u.common->omp_declare_target_link + && list != OMP_LIST_LINK) + gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously " + "mentioned in LINK clause and later in TO clause", + &n->where); + else if (n->u.common->omp_declare_target + && !n->u.common->omp_declare_target_link + && list == OMP_LIST_LINK) + gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously " + "mentioned in TO clause and later in LINK clause", + &n->where); + else if (n->u.common->head && n->u.common->head->mark) + gfc_error_now ("COMMON at %L mentioned multiple times in " + "clauses of the same OMP DECLARE TARGET directive", + &n->where); + else + { + n->u.common->omp_declare_target = 1; + n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK); + for (s = n->u.common->head; s; s = s->common_next) + { + s->mark = 1; + if (gfc_add_omp_declare_target (&s->attr, s->name, + &s->declared_at)) + { + if (list == OMP_LIST_LINK) + gfc_add_omp_declare_target_link (&s->attr, s->name, + &s->declared_at); + } + } } - st->n.common->omp_declare_target = 1; - for (sym = st->n.common->head; sym; sym = sym->common_next) - if (!gfc_add_omp_declare_target (&sym->attr, sym->name, - &sym->declared_at)) - goto cleanup; - next_item: - if (gfc_match_char (')') == MATCH_YES) - break; - if (gfc_match_char (',') != MATCH_YES) - goto syntax; - } + gfc_buffer_error (true); - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C"); - goto cleanup; - } + if (c) + gfc_free_omp_clauses (c); return MATCH_YES; syntax: @@ -2479,6 +3111,8 @@ syntax: cleanup: gfc_current_locus = old_loc; + if (c) + gfc_free_omp_clauses (c); return MATCH_ERROR; } @@ -2576,8 +3210,7 @@ match gfc_match_omp_parallel_do_simd (void) { return match_omp (EXEC_OMP_PARALLEL_DO_SIMD, - (OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) - & ~OMP_CLAUSE_ORDERED); + OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES); } @@ -2613,57 +3246,70 @@ gfc_match_omp_simd (void) match gfc_match_omp_single (void) { - return match_omp (EXEC_OMP_SINGLE, - OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE); + return match_omp (EXEC_OMP_SINGLE, OMP_SINGLE_CLAUSES); } match -gfc_match_omp_task (void) +gfc_match_omp_target (void) { - return match_omp (EXEC_OMP_TASK, OMP_TASK_CLAUSES); + return match_omp (EXEC_OMP_TARGET, OMP_TARGET_CLAUSES); } match -gfc_match_omp_taskwait (void) +gfc_match_omp_target_data (void) { - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after TASKWAIT clause at %C"); - return MATCH_ERROR; - } - new_st.op = EXEC_OMP_TASKWAIT; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_TARGET_DATA, OMP_TARGET_DATA_CLAUSES); } match -gfc_match_omp_taskyield (void) +gfc_match_omp_target_enter_data (void) { - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after TASKYIELD clause at %C"); - return MATCH_ERROR; - } - new_st.op = EXEC_OMP_TASKYIELD; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_TARGET_ENTER_DATA, OMP_TARGET_ENTER_DATA_CLAUSES); } match -gfc_match_omp_target (void) +gfc_match_omp_target_exit_data (void) { - return match_omp (EXEC_OMP_TARGET, OMP_TARGET_CLAUSES); + return match_omp (EXEC_OMP_TARGET_EXIT_DATA, OMP_TARGET_EXIT_DATA_CLAUSES); } match -gfc_match_omp_target_data (void) +gfc_match_omp_target_parallel (void) { - return match_omp (EXEC_OMP_TARGET_DATA, OMP_TARGET_DATA_CLAUSES); + return match_omp (EXEC_OMP_TARGET_PARALLEL, + (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_COPYIN))); +} + + +match +gfc_match_omp_target_parallel_do (void) +{ + return match_omp (EXEC_OMP_TARGET_PARALLEL_DO, + (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES) & ~(omp_mask (OMP_CLAUSE_COPYIN))); +} + + +match +gfc_match_omp_target_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_TARGET_PARALLEL_DO_SIMD, + (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES + | OMP_SIMD_CLAUSES) & ~(omp_mask (OMP_CLAUSE_COPYIN))); +} + + +match +gfc_match_omp_target_simd (void) +{ + return match_omp (EXEC_OMP_TARGET_SIMD, + OMP_TARGET_CLAUSES | OMP_SIMD_CLAUSES); } @@ -2688,9 +3334,11 @@ match gfc_match_omp_target_teams_distribute_parallel_do (void) { return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, - OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES - | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES - | OMP_DO_CLAUSES); + (OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_ORDERED)) + & ~(omp_mask (OMP_CLAUSE_LINEAR))); } @@ -2701,7 +3349,7 @@ gfc_match_omp_target_teams_distribute_parallel_do_simd (void) (OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) - & ~OMP_CLAUSE_ORDERED); + & ~(omp_mask (OMP_CLAUSE_ORDERED))); } @@ -2722,6 +3370,57 @@ gfc_match_omp_target_update (void) match +gfc_match_omp_task (void) +{ + return match_omp (EXEC_OMP_TASK, OMP_TASK_CLAUSES); +} + + +match +gfc_match_omp_taskloop (void) +{ + return match_omp (EXEC_OMP_TASKLOOP, OMP_TASKLOOP_CLAUSES); +} + + +match +gfc_match_omp_taskloop_simd (void) +{ + return match_omp (EXEC_OMP_TASKLOOP_SIMD, + (OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_REDUCTION))); +} + + +match +gfc_match_omp_taskwait (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after TASKWAIT clause at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKWAIT; + new_st.ext.omp_clauses = NULL; + return MATCH_YES; +} + + +match +gfc_match_omp_taskyield (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after TASKYIELD clause at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKYIELD; + new_st.ext.omp_clauses = NULL; + return MATCH_YES; +} + + +match gfc_match_omp_teams (void) { return match_omp (EXEC_OMP_TEAMS, OMP_TEAMS_CLAUSES); @@ -2740,8 +3439,10 @@ match gfc_match_omp_teams_distribute_parallel_do (void) { return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, - OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES - | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES); + (OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES + | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_ORDERED)) + & ~(omp_mask (OMP_CLAUSE_LINEAR))); } @@ -2751,7 +3452,7 @@ gfc_match_omp_teams_distribute_parallel_do_simd (void) return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, (OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES - | OMP_SIMD_CLAUSES) & ~OMP_CLAUSE_ORDERED); + | OMP_SIMD_CLAUSES) & ~(omp_mask (OMP_CLAUSE_ORDERED))); } @@ -2795,14 +3496,14 @@ gfc_match_omp_master (void) match gfc_match_omp_ordered (void) { - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after $OMP ORDERED statement at %C"); - return MATCH_ERROR; - } - new_st.op = EXEC_OMP_ORDERED; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_ORDERED, OMP_ORDERED_CLAUSES); +} + + +match +gfc_match_omp_ordered_depend (void) +{ + return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND)); } @@ -2915,7 +3616,7 @@ gfc_match_omp_cancel (void) enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind (); if (kind == OMP_CANCEL_UNKNOWN) return MATCH_ERROR; - if (gfc_match_omp_clauses (&c, OMP_CLAUSE_IF, false) != MATCH_YES) + if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_IF), false) != MATCH_YES) return MATCH_ERROR; c->cancel = kind; new_st.op = EXEC_OMP_CANCEL; @@ -2972,7 +3673,8 @@ gfc_match_omp_end_single (void) new_st.ext.omp_bool = true; return MATCH_YES; } - if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE) != MATCH_YES) + if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_COPYPRIVATE)) + != MATCH_YES) return MATCH_ERROR; new_st.op = EXEC_OMP_END_SINGLE; new_st.ext.omp_clauses = c; @@ -2989,23 +3691,35 @@ oacc_is_loop (gfc_code *code) } static void -resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause) +resolve_scalar_int_expr (gfc_expr *expr, const char *clause) { if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) + || expr->ts.type != BT_INTEGER + || expr->rank != 0) gfc_error ("%s clause at %L requires a scalar INTEGER expression", - clause, &expr->where); + clause, &expr->where); } - static void -resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause) +resolve_positive_int_expr (gfc_expr *expr, const char *clause) { - resolve_oacc_scalar_int_expr (expr, clause); - if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER - && mpz_sgn(expr->value.integer) <= 0) + resolve_scalar_int_expr (expr, clause); + if (expr->expr_type == EXPR_CONSTANT + && expr->ts.type == BT_INTEGER + && mpz_sgn (expr->value.integer) <= 0) gfc_warning (0, "INTEGER expression of %s clause at %L must be positive", - clause, &expr->where); + clause, &expr->where); +} + +static void +resolve_nonnegative_int_expr (gfc_expr *expr, const char *clause) +{ + resolve_scalar_int_expr (expr, clause); + if (expr->expr_type == EXPR_CONSTANT + && expr->ts.type == BT_INTEGER + && mpz_sgn (expr->value.integer) < 0) + gfc_warning (0, "INTEGER expression of %s clause at %L must be " + "non-negative", clause, &expr->where); } /* Emits error when symbol is pointer, cray pointer or cray pointee @@ -3018,10 +3732,10 @@ check_symbol_not_pointer (gfc_symbol *sym, locus loc, const char *name) gfc_error ("POINTER object %qs of derived type in %s clause at %L", sym->name, name, &loc); if (sym->ts.type == BT_DERIVED && sym->attr.cray_pointer) - gfc_error ("Cray pointer object of derived type %qs in %s clause at %L", + gfc_error ("Cray pointer object %qs of derived type in %s clause at %L", sym->name, name, &loc); if (sym->ts.type == BT_DERIVED && sym->attr.cray_pointee) - gfc_error ("Cray pointee object of derived type %qs in %s clause at %L", + gfc_error ("Cray pointee object %qs of derived type in %s clause at %L", sym->name, name, &loc); if ((sym->ts.type == BT_ASSUMED && sym->attr.pointer) @@ -3032,12 +3746,12 @@ check_symbol_not_pointer (gfc_symbol *sym, locus loc, const char *name) if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointer) || (sym->ts.type == BT_CLASS && CLASS_DATA (sym) && CLASS_DATA (sym)->attr.cray_pointer)) - gfc_error ("Cray pointer object of polymorphic type %qs in %s clause at %L", + gfc_error ("Cray pointer object %qs of polymorphic type in %s clause at %L", sym->name, name, &loc); if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointee) || (sym->ts.type == BT_CLASS && CLASS_DATA (sym) && CLASS_DATA (sym)->attr.cray_pointee)) - gfc_error ("Cray pointee object of polymorphic type %qs in %s clause at %L", + gfc_error ("Cray pointee object %qs of polymorphic type in %s clause at %L", sym->name, name, &loc); } @@ -3141,7 +3855,7 @@ resolve_omp_udr_callback2 (gfc_expr **e, int *, void *) if (!sym->attr.intrinsic && sym->attr.if_source == IFSRC_UNKNOWN) gfc_error ("Implicitly declared function %s used in " - "!$OMP DECLARE REDUCTION at %L ", sym->name, &(*e)->where); + "!$OMP DECLARE REDUCTION at %L", sym->name, &(*e)->where); } return 0; } @@ -3190,7 +3904,7 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns, && !sym->attr.intrinsic && sym->attr.if_source == IFSRC_UNKNOWN) gfc_error ("Implicitly declared subroutine %s used in " - "!$OMP DECLARE REDUCTION at %L ", sym->name, + "!$OMP DECLARE REDUCTION at %L", sym->name, ©->loc); } gfc_code_walker (©, gfc_dummy_code_callback, @@ -3209,15 +3923,22 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_omp_namelist *n; gfc_expr_list *el; int list; + int ifc; + bool if_without_mod = false; + gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT; static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", "TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", - "CACHE" }; + "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR" }; if (omp_clauses == NULL) return; + if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse) + gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L", + &code->loc); + if (omp_clauses->if_expr) { gfc_expr *expr = omp_clauses->if_expr; @@ -3225,7 +3946,101 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, || expr->ts.type != BT_LOGICAL || expr->rank != 0) gfc_error ("IF clause at %L requires a scalar LOGICAL expression", &expr->where); + if_without_mod = true; } + for (ifc = 0; ifc < OMP_IF_LAST; ifc++) + if (omp_clauses->if_exprs[ifc]) + { + gfc_expr *expr = omp_clauses->if_exprs[ifc]; + bool ok = true; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_LOGICAL || expr->rank != 0) + gfc_error ("IF clause at %L requires a scalar LOGICAL expression", + &expr->where); + else if (if_without_mod) + { + gfc_error ("IF clause without modifier at %L used together with " + "IF clauses with modifiers", + &omp_clauses->if_expr->where); + if_without_mod = false; + } + else + switch (code->op) + { + case EXEC_OMP_PARALLEL: + case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + ok = ifc == OMP_IF_PARALLEL; + break; + + case EXEC_OMP_TASK: + ok = ifc == OMP_IF_TASK; + break; + + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: + ok = ifc == OMP_IF_TASKLOOP; + break; + + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_SIMD: + ok = ifc == OMP_IF_TARGET; + break; + + case EXEC_OMP_TARGET_DATA: + ok = ifc == OMP_IF_TARGET_DATA; + break; + + case EXEC_OMP_TARGET_UPDATE: + ok = ifc == OMP_IF_TARGET_UPDATE; + break; + + case EXEC_OMP_TARGET_ENTER_DATA: + ok = ifc == OMP_IF_TARGET_ENTER_DATA; + break; + + case EXEC_OMP_TARGET_EXIT_DATA: + ok = ifc == OMP_IF_TARGET_EXIT_DATA; + break; + + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_PARALLEL; + break; + + default: + ok = false; + break; + } + if (!ok) + { + static const char *ifs[] = { + "PARALLEL", + "TASK", + "TASKLOOP", + "TARGET", + "TARGET DATA", + "TARGET UPDATE", + "TARGET ENTER DATA", + "TARGET EXIT DATA" + }; + gfc_error ("IF clause modifier %s at %L not appropriate for " + "the current OpenMP construct", ifs[ifc], &expr->where); + } + } + if (omp_clauses->final_expr) { gfc_expr *expr = omp_clauses->final_expr; @@ -3235,13 +4050,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, &expr->where); } if (omp_clauses->num_threads) - { - gfc_expr *expr = omp_clauses->num_threads; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("NUM_THREADS clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->num_threads, "NUM_THREADS"); if (omp_clauses->chunk_size) { gfc_expr *expr = omp_clauses->chunk_size; @@ -3249,6 +4058,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, || expr->ts.type != BT_INTEGER || expr->rank != 0) gfc_error ("SCHEDULE clause's chunk_size at %L requires " "a scalar INTEGER expression", &expr->where); + else if (expr->expr_type == EXPR_CONSTANT + && expr->ts.type == BT_INTEGER + && mpz_sgn (expr->value.integer) <= 0) + gfc_warning (0, "INTEGER expression of SCHEDULE clause's chunk_size " + "at %L must be positive", &expr->where); } /* Check that no symbol appears on multiple clauses, except that @@ -3474,6 +4288,36 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case OMP_LIST_CACHE: for (; n != NULL; n = n->next) { + if (list == OMP_LIST_DEPEND) + { + if (n->u.depend_op == OMP_DEPEND_SINK_FIRST + || n->u.depend_op == OMP_DEPEND_SINK) + { + if (code->op != EXEC_OMP_ORDERED) + gfc_error ("SINK dependence type only allowed " + "on ORDERED directive at %L", &n->where); + else if (omp_clauses->depend_source) + { + gfc_error ("DEPEND SINK used together with " + "DEPEND SOURCE on the same construct " + "at %L", &n->where); + omp_clauses->depend_source = false; + } + else if (n->expr) + { + if (!gfc_resolve_expr (n->expr) + || n->expr->ts.type != BT_INTEGER + || n->expr->rank != 0) + gfc_error ("SINK addend not a constant integer " + "at %L", &n->where); + } + continue; + } + else if (code->op == EXEC_OMP_ORDERED) + gfc_error ("Only SOURCE or SINK dependence types " + "are allowed on ORDERED directive at %L", + &n->where); + } if (n->expr) { if (!gfc_resolve_expr (n->expr) @@ -3530,6 +4374,67 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, else resolve_oacc_data_clauses (n->sym, n->where, name); } + else if (list != OMP_CLAUSE_DEPEND + && n->sym->as + && n->sym->as->type == AS_ASSUMED_SIZE) + gfc_error ("Assumed size array %qs in %s clause at %L", + n->sym->name, name, &n->where); + if (list == OMP_LIST_MAP && !openacc) + switch (code->op) + { + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + switch (n->u.map_op) + { + case OMP_MAP_TO: + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_FROM: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_TOFROM: + case OMP_MAP_ALWAYS_TOFROM: + case OMP_MAP_ALLOC: + break; + default: + gfc_error ("TARGET%s with map-type other than TO, " + "FROM, TOFROM, or ALLOC on MAP clause " + "at %L", + code->op == EXEC_OMP_TARGET + ? "" : " DATA", &n->where); + break; + } + break; + case EXEC_OMP_TARGET_ENTER_DATA: + switch (n->u.map_op) + { + case OMP_MAP_TO: + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_ALLOC: + break; + default: + gfc_error ("TARGET ENTER DATA with map-type other " + "than TO, or ALLOC on MAP clause at %L", + &n->where); + break; + } + break; + case EXEC_OMP_TARGET_EXIT_DATA: + switch (n->u.map_op) + { + case OMP_MAP_FROM: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_RELEASE: + case OMP_MAP_DELETE: + break; + default: + gfc_error ("TARGET EXIT DATA with map-type other " + "than FROM, RELEASE, or DELETE on MAP " + "clause at %L", &n->where); + break; + } + break; + default: + break; + } } if (list != OMP_LIST_DEPEND) @@ -3544,6 +4449,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->name, name, &n->where); } break; + case OMP_LIST_IS_DEVICE_PTR: + case OMP_LIST_USE_DEVICE_PTR: + /* FIXME: Handle these. */ + break; default: for (; n != NULL; n = n->next) { @@ -3701,12 +4610,30 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } break; case OMP_LIST_LINEAR: - if (n->sym->ts.type != BT_INTEGER) + if (code + && n->u.linear_op != OMP_LINEAR_DEFAULT + && n->u.linear_op != linear_op) + { + gfc_error ("LINEAR clause modifier used on DO or SIMD" + " construct at %L", &n->where); + linear_op = n->u.linear_op; + } + else if (omp_clauses->orderedc) + gfc_error ("LINEAR clause specified together with " + "ORDERED clause with argument at %L", + &n->where); + else if (n->u.linear_op != OMP_LINEAR_REF + && n->sym->ts.type != BT_INTEGER) gfc_error ("LINEAR variable %qs must be INTEGER " "at %L", n->sym->name, &n->where); - else if (!code && !n->sym->attr.value) - gfc_error ("LINEAR dummy argument %qs must have VALUE " - "attribute at %L", n->sym->name, &n->where); + else if ((n->u.linear_op == OMP_LINEAR_REF + || n->u.linear_op == OMP_LINEAR_UVAL) + && n->sym->attr.value) + gfc_error ("LINEAR dummy argument %qs with VALUE " + "attribute with %s modifier at %L", + n->sym->name, + n->u.linear_op == OMP_LINEAR_REF + ? "REF" : "UVAL", &n->where); else if (n->expr) { gfc_expr *expr = n->expr; @@ -3717,9 +4644,25 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "a scalar integer linear-step expression", n->sym->name, &n->where); else if (!code && expr->expr_type != EXPR_CONSTANT) - gfc_error ("%qs in LINEAR clause at %L requires " - "a constant integer linear-step expression", - n->sym->name, &n->where); + { + if (expr->expr_type == EXPR_VARIABLE + && expr->symtree->n.sym->attr.dummy + && expr->symtree->n.sym->ns == ns) + { + gfc_omp_namelist *n2; + for (n2 = omp_clauses->lists[OMP_LIST_UNIFORM]; + n2; n2 = n2->next) + if (n2->sym == expr->symtree->n.sym) + break; + if (n2) + break; + } + gfc_error ("%qs in LINEAR clause at %L requires " + "a constant integer linear-step " + "expression or dummy argument " + "specified in UNIFORM clause", + n->sym->name, &n->where); + } } break; /* Workaround for PR middle-end/26316, nothing really needs @@ -3733,17 +4676,24 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && CLASS_DATA (n->sym)->attr.allocatable)) gfc_error ("ALLOCATABLE object %qs in %s clause at %L", n->sym->name, name, &n->where); - if (n->sym->attr.pointer - || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym) - && CLASS_DATA (n->sym)->attr.class_pointer)) - gfc_error ("POINTER object %qs in %s clause at %L", - n->sym->name, name, &n->where); + if (n->sym->ts.type == BT_CLASS + && CLASS_DATA (n->sym) + && CLASS_DATA (n->sym)->attr.class_pointer) + gfc_error ("POINTER object %qs of polymorphic type in " + "%s clause at %L", n->sym->name, name, + &n->where); if (n->sym->attr.cray_pointer) gfc_error ("Cray pointer object %qs in %s clause at %L", n->sym->name, name, &n->where); - if (n->sym->attr.cray_pointee) + else if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee object %qs in %s clause at %L", n->sym->name, name, &n->where); + else if (n->sym->attr.flavor == FL_VARIABLE + && !n->sym->as + && !n->sym->attr.pointer) + gfc_error ("%s clause variable %qs at %L is neither " + "a POINTER nor an array", name, + n->sym->name, &n->where); /* FALLTHRU */ case OMP_LIST_DEVICE_RESIDENT: check_symbol_not_pointer (n->sym, n->where, name); @@ -3757,37 +4707,17 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } } if (omp_clauses->safelen_expr) - { - gfc_expr *expr = omp_clauses->safelen_expr; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("SAFELEN clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN"); if (omp_clauses->simdlen_expr) - { - gfc_expr *expr = omp_clauses->simdlen_expr; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("SIMDLEN clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN"); if (omp_clauses->num_teams) - { - gfc_expr *expr = omp_clauses->num_teams; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("NUM_TEAMS clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS"); if (omp_clauses->device) - { - gfc_expr *expr = omp_clauses->device; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("DEVICE clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE"); + if (omp_clauses->hint) + resolve_scalar_int_expr (omp_clauses->hint, "HINT"); + if (omp_clauses->priority) + resolve_nonnegative_int_expr (omp_clauses->priority, "PRIORITY"); if (omp_clauses->dist_chunk_size) { gfc_expr *expr = omp_clauses->dist_chunk_size; @@ -3797,36 +4727,52 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "a scalar INTEGER expression", &expr->where); } if (omp_clauses->thread_limit) - { - gfc_expr *expr = omp_clauses->thread_limit; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("THREAD_LIMIT clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->thread_limit, "THREAD_LIMIT"); + if (omp_clauses->grainsize) + resolve_positive_int_expr (omp_clauses->grainsize, "GRAINSIZE"); + if (omp_clauses->num_tasks) + resolve_positive_int_expr (omp_clauses->num_tasks, "NUM_TASKS"); if (omp_clauses->async) if (omp_clauses->async_expr) - resolve_oacc_scalar_int_expr (omp_clauses->async_expr, "ASYNC"); + resolve_scalar_int_expr (omp_clauses->async_expr, "ASYNC"); if (omp_clauses->num_gangs_expr) - resolve_oacc_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS"); + resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS"); if (omp_clauses->num_workers_expr) - resolve_oacc_positive_int_expr (omp_clauses->num_workers_expr, - "NUM_WORKERS"); + resolve_positive_int_expr (omp_clauses->num_workers_expr, "NUM_WORKERS"); if (omp_clauses->vector_length_expr) - resolve_oacc_positive_int_expr (omp_clauses->vector_length_expr, - "VECTOR_LENGTH"); + resolve_positive_int_expr (omp_clauses->vector_length_expr, + "VECTOR_LENGTH"); if (omp_clauses->gang_num_expr) - resolve_oacc_positive_int_expr (omp_clauses->gang_num_expr, "GANG"); + resolve_positive_int_expr (omp_clauses->gang_num_expr, "GANG"); if (omp_clauses->gang_static_expr) - resolve_oacc_positive_int_expr (omp_clauses->gang_static_expr, "GANG"); + resolve_positive_int_expr (omp_clauses->gang_static_expr, "GANG"); if (omp_clauses->worker_expr) - resolve_oacc_positive_int_expr (omp_clauses->worker_expr, "WORKER"); + resolve_positive_int_expr (omp_clauses->worker_expr, "WORKER"); if (omp_clauses->vector_expr) - resolve_oacc_positive_int_expr (omp_clauses->vector_expr, "VECTOR"); + resolve_positive_int_expr (omp_clauses->vector_expr, "VECTOR"); if (omp_clauses->wait) if (omp_clauses->wait_list) for (el = omp_clauses->wait_list; el; el = el->next) - resolve_oacc_scalar_int_expr (el->expr, "WAIT"); + resolve_scalar_int_expr (el->expr, "WAIT"); + if (omp_clauses->collapse && omp_clauses->tile_list) + gfc_error ("Incompatible use of TILE and COLLAPSE at %L", &code->loc); + if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED) + gfc_error ("SOURCE dependence type only allowed " + "on ORDERED directive at %L", &code->loc); + if (!openacc && code && omp_clauses->lists[OMP_LIST_MAP] == NULL) + { + const char *p = NULL; + switch (code->op) + { + case EXEC_OMP_TARGET_DATA: p = "TARGET DATA"; break; + case EXEC_OMP_TARGET_ENTER_DATA: p = "TARGET ENTER DATA"; break; + case EXEC_OMP_TARGET_EXIT_DATA: p = "TARGET EXIT DATA"; break; + default: break; + } + if (p) + gfc_error ("%s must contain at least one MAP clause at %L", + p, &code->loc); + } } @@ -3914,12 +4860,33 @@ resolve_omp_atomic (gfc_code *code) = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK); code = code->block->next; - gcc_assert (code->op == EXEC_ASSIGN); - gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE) && code->next == NULL) - || ((aop == GFC_OMP_ATOMIC_CAPTURE) - && code->next != NULL - && code->next->op == EXEC_ASSIGN - && code->next->next == NULL)); + /* resolve_blocks asserts this is initially EXEC_ASSIGN. + If it changed to EXEC_NOP, assume an error has been emitted already. */ + if (code->op == EXEC_NOP) + return; + if (code->op != EXEC_ASSIGN) + { + unexpected: + gfc_error ("unexpected !$OMP ATOMIC expression at %L", &code->loc); + return; + } + if (aop != GFC_OMP_ATOMIC_CAPTURE) + { + if (code->next != NULL) + goto unexpected; + } + else + { + if (code->next == NULL) + goto unexpected; + if (code->next->op == EXEC_NOP) + return; + if (code->next->op != EXEC_ASSIGN || code->next->next) + { + code = code->next; + goto unexpected; + } + } if (code->expr1->expr_type != EXPR_VARIABLE || code->expr1->symtree == NULL @@ -4308,7 +5275,10 @@ gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns) gfc_code *c; omp_current_do_code = code->block->next; - omp_current_do_collapse = code->ext.omp_clauses->collapse; + if (code->ext.omp_clauses->orderedc) + omp_current_do_collapse = code->ext.omp_clauses->orderedc; + else + omp_current_do_collapse = code->ext.omp_clauses->collapse; for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++) { c = c->block; @@ -4362,6 +5332,8 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) { case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -4487,8 +5459,17 @@ resolve_omp_do (gfc_code *code) is_simd = true; break; case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break; + case EXEC_OMP_TARGET_PARALLEL_DO: name = "!$OMP TARGET PARALLEL DO"; break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + name = "!$OMP TARGET PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_TARGET_SIMD: + name = "!$OMP TARGET SIMD"; + is_simd = true; + break; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: - name = "!$OMP TARGET TEAMS_DISTRIBUTE"; + name = "!$OMP TARGET TEAMS DISTRIBUTE"; break; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: name = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO"; @@ -4501,7 +5482,12 @@ resolve_omp_do (gfc_code *code) name = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; is_simd = true; break; - case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS_DISTRIBUTE"; break; + case EXEC_OMP_TASKLOOP: name = "!$OMP TASKLOOP"; break; + case EXEC_OMP_TASKLOOP_SIMD: + name = "!$OMP TASKLOOP SIMD"; + is_simd = true; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS DISTRIBUTE"; break; case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: name = "!$OMP TEAMS DISTRIBUTE PARALLEL DO"; break; @@ -4520,9 +5506,14 @@ resolve_omp_do (gfc_code *code) resolve_omp_clauses (code, code->ext.omp_clauses, NULL); do_code = code->block->next; - collapse = code->ext.omp_clauses->collapse; - if (collapse <= 0) - collapse = 1; + if (code->ext.omp_clauses->orderedc) + collapse = code->ext.omp_clauses->orderedc; + else + { + collapse = code->ext.omp_clauses->collapse; + if (collapse <= 0) + collapse = 1; + } for (i = 1; i <= collapse; i++) { if (do_code->op == EXEC_DO_WHILE) @@ -4911,15 +5902,15 @@ resolve_oacc_loop_blocks (gfc_code *code) if (el->expr == NULL) { /* NULL expressions are used to represent '*' arguments. - Convert those to a -1 expressions. */ + Convert those to a 0 expressions. */ el->expr = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind, &code->loc); - mpz_set_si (el->expr->value.integer, -1); + mpz_set_si (el->expr->value.integer, 0); } else { - resolve_oacc_positive_int_expr (el->expr, "TILE"); + resolve_positive_int_expr (el->expr, "TILE"); if (el->expr->expr_type != EXPR_CONSTANT) gfc_error ("TILE requires constant expression at %L", &code->loc); @@ -4994,7 +5985,7 @@ gfc_resolve_oacc_declare (gfc_namespace *ns) if (n->expr && n->expr->ref->type == REF_ARRAY) { gfc_error ("Array sections: %qs not allowed in" - " $!ACC DECLARE at %L", n->sym->name, &oc->loc); + " !$ACC DECLARE at %L", n->sym->name, &oc->loc); continue; } } @@ -5081,10 +6072,15 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -5099,6 +6095,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TASK: case EXEC_OMP_TEAMS: @@ -5132,7 +6131,8 @@ gfc_resolve_omp_declare_simd (gfc_namespace *ns) for (ods = ns->omp_declare_simd; ods; ods = ods->next) { - if (ods->proc_name != ns->proc_name) + if (ods->proc_name != NULL + && ods->proc_name != ns->proc_name) gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure " "%qs at %L", ns->proc_name->name, &ods->where); if (ods->clauses) diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 5a91ec1b20..1af76aa81e 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -1,5 +1,5 @@ /* Parse and display command line options. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -47,12 +47,27 @@ set_default_std_flags (void) } -/* Set all the DEC extension flags. */ +/* Set all the DEC extension flags. */ static void set_dec_flags (int value) { - gfc_option.flag_dec_structure = value; + /* Allow legacy code without warnings. */ + gfc_option.allow_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL + | GFC_STD_GNU | GFC_STD_LEGACY; + gfc_option.warn_std &= ~(GFC_STD_LEGACY | GFC_STD_F95_DEL); + + /* Set -fd-lines-as-comments by default. */ + if (value && gfc_current_form != FORM_FREE && gfc_option.flag_d_lines == -1) + gfc_option.flag_d_lines = 0; + + /* Set other DEC compatibility extensions. */ + flag_dollar_ok |= value; + flag_cray_pointer |= value; + flag_dec_structure |= value; + flag_dec_intrinsic_ints |= value; + flag_dec_static |= value; + flag_dec_math |= value; } @@ -208,8 +223,7 @@ gfc_post_options (const char **pfilename) /* Excess precision other than "fast" requires front-end support. */ - if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD - && TARGET_FLT_EVAL_METHOD_NON_DEFAULT) + if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD) sorry ("-fexcess-precision=standard for Fortran"); flag_excess_precision_cmdline = EXCESS_PRECISION_FAST; @@ -374,10 +388,16 @@ gfc_post_options (const char **pfilename) if (!flag_automatic) flag_max_stack_var_size = 0; - /* If we call BLAS directly, only inline up to the BLAS limit. */ + /* If the user did not specify an inline matmul limit, inline up to the BLAS + limit or up to 30 if no external BLAS is specified. */ - if (flag_external_blas && flag_inline_matmul_limit < 0) - flag_inline_matmul_limit = flag_blas_matmul_limit; + if (flag_inline_matmul_limit < 0) + { + if (flag_external_blas) + flag_inline_matmul_limit = flag_blas_matmul_limit; + else + flag_inline_matmul_limit = 30; + } /* Optimization implies front end optimization, unless the user specified it directly. */ @@ -727,7 +747,7 @@ gfc_handle_option (size_t scode, const char *arg, int value, break; case OPT_fdec_structure: - gfc_option.flag_dec_structure = 1; + flag_dec_structure = 1; break; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 0aa736c708..305a036a71 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1,5 +1,5 @@ /* Main parser. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -116,7 +116,6 @@ use_modules (void) gfc_pop_error (&old_error); gfc_commit_symbols (); gfc_warning_check (); - gfc_current_ns->old_cl_list = gfc_current_ns->cl_list; gfc_current_ns->old_equiv = gfc_current_ns->equiv; gfc_current_ns->old_data = gfc_current_ns->data; last_was_use_stmt = false; @@ -191,6 +190,7 @@ decode_specification_statement (void) ST_INTERFACE); match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL); match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL); + match ("automatic", gfc_match_automatic, ST_ATTR_DECL); break; case 'b': @@ -256,6 +256,7 @@ decode_specification_statement (void) case 's': match ("save", gfc_match_save, ST_ATTR_DECL); + match ("static", gfc_match_static, ST_ATTR_DECL); match ("structure", gfc_match_structure_decl, ST_STRUCTURE_DECL); break; @@ -293,7 +294,6 @@ static bool in_specification_block; static gfc_statement decode_statement (void) { - gfc_namespace *ns; gfc_statement st; locus old_locus; match m = MATCH_NO; @@ -351,6 +351,9 @@ decode_statement (void) } gfc_matching_function = false; + /* Legacy parameter statements are ambiguous with assignments so try parameter + first. */ + match ("parameter", gfc_match_parameter, ST_PARAMETER); /* Match statements whose error messages are meant to be overwritten by something better. */ @@ -411,17 +414,18 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; + /* Try to match TYPE as an alias for PRINT. */ + if (gfc_match_type (&st) == MATCH_YES) + return st; + gfc_undo_symbols (); + gfc_current_locus = old_locus; + match (NULL, gfc_match_do, ST_DO); match (NULL, gfc_match_block, ST_BLOCK); match (NULL, gfc_match_associate, ST_ASSOCIATE); match (NULL, gfc_match_critical, ST_CRITICAL); match (NULL, gfc_match_select, ST_SELECT_CASE); - - gfc_current_ns = gfc_build_block_ns (gfc_current_ns); match (NULL, gfc_match_select_type, ST_SELECT_TYPE); - ns = gfc_current_ns; - gfc_current_ns = gfc_current_ns->parent; - gfc_free_namespace (ns); /* General statement matching: Instead of testing every possible statement, we eliminate most possibilities by peeking at the @@ -436,6 +440,7 @@ decode_statement (void) match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL); match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT); match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL); + match ("automatic", gfc_match_automatic, ST_ATTR_DECL); break; case 'b': @@ -483,6 +488,7 @@ decode_statement (void) break; case 'f': + match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE); match ("final", gfc_match_final_decl, ST_FINAL); match ("flush", gfc_match_flush, ST_FLUSH); match ("format", gfc_match_format, ST_FORMAT); @@ -525,7 +531,6 @@ decode_statement (void) case 'p': match ("print", gfc_match_print, ST_WRITE); - match ("parameter", gfc_match_parameter, ST_PARAMETER); match ("pause", gfc_match_pause, ST_PAUSE); match ("pointer", gfc_match_pointer, ST_ATTR_DECL); if (gfc_match_private (&st) == MATCH_YES) @@ -548,6 +553,7 @@ decode_statement (void) match ("sequence", gfc_match_eos, ST_SEQUENCE); match ("stop", gfc_match_stop, ST_STOP); match ("save", gfc_match_save, ST_ATTR_DECL); + match ("static", gfc_match_static, ST_ATTR_DECL); match ("submodule", gfc_match_submodule, ST_SUBMODULE); match ("sync all", gfc_match_sync_all, ST_SYNC_ALL); match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES); @@ -716,7 +722,10 @@ decode_oacc_directive (void) goto do_spec_only; \ if (match_word_omp_simd (keyword, subr, &old_locus, \ &simd_matched) == MATCH_YES) \ - return st; \ + { \ + ret = st; \ + goto finish; \ + } \ else \ undo_new_statement (); \ } while (0); @@ -731,7 +740,10 @@ decode_oacc_directive (void) goto do_spec_only; \ else if (match_word (keyword, subr, &old_locus) \ == MATCH_YES) \ - return st; \ + { \ + ret = st; \ + goto finish; \ + } \ else \ undo_new_statement (); \ } while (0); @@ -741,7 +753,10 @@ decode_oacc_directive (void) do { \ if (match_word_omp_simd (keyword, subr, &old_locus, \ &simd_matched) == MATCH_YES) \ - return st; \ + { \ + ret = st; \ + goto finish; \ + } \ else \ undo_new_statement (); \ } while (0); @@ -753,7 +768,10 @@ decode_oacc_directive (void) ; \ else if (match_word (keyword, subr, &old_locus) \ == MATCH_YES) \ - return st; \ + { \ + ret = st; \ + goto finish; \ + } \ else \ undo_new_statement (); \ } while (0); @@ -765,26 +783,18 @@ decode_omp_directive (void) char c; bool simd_matched = false; bool spec_only = false; + gfc_statement ret = ST_NONE; + bool pure_ok = true; gfc_enforce_clean_symbol_state (); gfc_clear_error (); /* Clear any pending errors. */ gfc_clear_warning (); /* Clear any pending warnings. */ - if (gfc_pure (NULL)) - { - gfc_error_now ("OpenMP directives at %C may not appear in PURE " - "or ELEMENTAL procedures"); - gfc_error_recovery (); - return ST_NONE; - } - if (gfc_current_state () == COMP_FUNCTION && gfc_current_block ()->result->ts.kind == -1) spec_only = true; - gfc_unset_implicit_pure (NULL); - old_locus = gfc_current_locus; /* General OpenMP directive matching: Instead of testing every possible @@ -795,6 +805,33 @@ decode_omp_directive (void) /* match is for directives that should be recognized only if -fopenmp, matchs for directives that should be recognized + if either -fopenmp or -fopenmp-simd. + Handle only the directives allowed in PURE/ELEMENTAL procedures + first (those also shall not turn off implicit pure). */ + switch (c) + { + case 'd': + matchds ("declare simd", gfc_match_omp_declare_simd, + ST_OMP_DECLARE_SIMD); + matchdo ("declare target", gfc_match_omp_declare_target, + ST_OMP_DECLARE_TARGET); + break; + case 's': + matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD); + break; + } + + pure_ok = false; + if (flag_openmp && gfc_pure (NULL)) + { + gfc_error_now ("OpenMP directives other than SIMD or DECLARE TARGET " + "at %C may not appear in PURE or ELEMENTAL procedures"); + gfc_error_recovery (); + return ST_NONE; + } + + /* match is for directives that should be recognized only if + -fopenmp, matchs for directives that should be recognized if either -fopenmp or -fopenmp-simd. */ switch (c) { @@ -813,10 +850,6 @@ decode_omp_directive (void) case 'd': matchds ("declare reduction", gfc_match_omp_declare_reduction, ST_OMP_DECLARE_REDUCTION); - matchds ("declare simd", gfc_match_omp_declare_simd, - ST_OMP_DECLARE_SIMD); - matchdo ("declare target", gfc_match_omp_declare_target, - ST_OMP_DECLARE_TARGET); matchs ("distribute parallel do simd", gfc_match_omp_distribute_parallel_do_simd, ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD); @@ -830,7 +863,7 @@ decode_omp_directive (void) break; case 'e': matcho ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC); - matcho ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL); + matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL); matchs ("end distribute parallel do simd", gfc_match_omp_eos, ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD); matcho ("end distribute parallel do", gfc_match_omp_eos, @@ -854,6 +887,13 @@ 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, ST_OMP_END_TARGET_DATA); + matchs ("end target parallel do simd", gfc_match_omp_eos, + ST_OMP_END_TARGET_PARALLEL_DO_SIMD); + matcho ("end target parallel do", gfc_match_omp_eos, + ST_OMP_END_TARGET_PARALLEL_DO); + matcho ("end target parallel", gfc_match_omp_eos, + ST_OMP_END_TARGET_PARALLEL); + matchs ("end target simd", gfc_match_omp_eos, ST_OMP_END_TARGET_SIMD); matchs ("end target teams distribute parallel do simd", gfc_match_omp_eos, ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); @@ -866,6 +906,9 @@ decode_omp_directive (void) matcho ("end target teams", gfc_match_omp_eos, ST_OMP_END_TARGET_TEAMS); matcho ("end target", gfc_match_omp_eos, ST_OMP_END_TARGET); matcho ("end taskgroup", gfc_match_omp_eos, ST_OMP_END_TASKGROUP); + matchs ("end taskloop simd", gfc_match_omp_eos, + ST_OMP_END_TASKLOOP_SIMD); + matcho ("end taskloop", gfc_match_omp_eos, ST_OMP_END_TASKLOOP); matcho ("end task", gfc_match_omp_eos, ST_OMP_END_TASK); matchs ("end teams distribute parallel do simd", gfc_match_omp_eos, ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); @@ -886,7 +929,14 @@ decode_omp_directive (void) matcho ("master", gfc_match_omp_master, ST_OMP_MASTER); break; case 'o': - matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); + if (flag_openmp && gfc_match ("ordered depend (") == MATCH_YES) + { + gfc_current_locus = old_locus; + matcho ("ordered", gfc_match_omp_ordered_depend, + ST_OMP_ORDERED_DEPEND); + } + else + matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); break; case 'p': matchs ("parallel do simd", gfc_match_omp_parallel_do_simd, @@ -901,11 +951,21 @@ decode_omp_directive (void) case 's': matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); matcho ("section", gfc_match_omp_eos, ST_OMP_SECTION); - matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD); matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE); break; case 't': matcho ("target data", gfc_match_omp_target_data, ST_OMP_TARGET_DATA); + matcho ("target enter data", gfc_match_omp_target_enter_data, + ST_OMP_TARGET_ENTER_DATA); + matcho ("target exit data", gfc_match_omp_target_exit_data, + ST_OMP_TARGET_EXIT_DATA); + matchs ("target parallel do simd", gfc_match_omp_target_parallel_do_simd, + ST_OMP_TARGET_PARALLEL_DO_SIMD); + matcho ("target parallel do", gfc_match_omp_target_parallel_do, + ST_OMP_TARGET_PARALLEL_DO); + matcho ("target parallel", gfc_match_omp_target_parallel, + ST_OMP_TARGET_PARALLEL); + matchs ("target simd", gfc_match_omp_target_simd, ST_OMP_TARGET_SIMD); matchs ("target teams distribute parallel do simd", gfc_match_omp_target_teams_distribute_parallel_do_simd, ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); @@ -922,6 +982,9 @@ decode_omp_directive (void) ST_OMP_TARGET_UPDATE); matcho ("target", gfc_match_omp_target, ST_OMP_TARGET); matcho ("taskgroup", gfc_match_omp_taskgroup, ST_OMP_TASKGROUP); + matchs ("taskloop simd", gfc_match_omp_taskloop_simd, + ST_OMP_TASKLOOP_SIMD); + matcho ("taskloop", gfc_match_omp_taskloop, ST_OMP_TASKLOOP); matcho ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT); matcho ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD); matcho ("task", gfc_match_omp_task, ST_OMP_TASK); @@ -961,6 +1024,23 @@ decode_omp_directive (void) return ST_NONE; + finish: + if (!pure_ok) + { + gfc_unset_implicit_pure (NULL); + + if (!flag_openmp && gfc_pure (NULL)) + { + gfc_error_now ("OpenMP directives other than SIMD or DECLARE TARGET " + "at %C may not appear in PURE or ELEMENTAL " + "procedures"); + reject_statement (); + gfc_error_recovery (); + return ST_NONE; + } + } + return ret; + do_spec_only: reject_statement (); gfc_clear_error (); @@ -1071,13 +1151,8 @@ next_free (void) } if (gfc_match_eos () == MATCH_YES) - { - gfc_warning_now (0, "Ignoring statement label in empty statement " - "at %L", &label_locus); - gfc_free_st_label (gfc_statement_label); - gfc_statement_label = NULL; - return ST_NONE; - } + gfc_error_now ("Statement label without statement at %L", + &label_locus); } } else if (c == '!') @@ -1262,7 +1337,7 @@ next_fixed (void) return decode_oacc_directive (); } } - /* FALLTHROUGH */ + gcc_fallthrough (); /* Comments have already been skipped by the time we get here so don't bother checking for them. */ @@ -1333,8 +1408,7 @@ next_fixed (void) blank_line: if (digit_flag) - gfc_warning_now (0, "Ignoring statement label in empty statement at %L", - &label_locus); + gfc_error_now ("Statement label without statement at %L", &label_locus); gfc_current_locus.lb->truncated = 0; gfc_advance_line (); @@ -1355,7 +1429,6 @@ next_statement (void) gfc_new_block = NULL; - gfc_current_ns->old_cl_list = gfc_current_ns->cl_list; gfc_current_ns->old_equiv = gfc_current_ns->equiv; gfc_current_ns->old_data = gfc_current_ns->data; for (;;) @@ -1423,9 +1496,11 @@ next_statement (void) case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \ case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ - case ST_OMP_TARGET_UPDATE: case ST_ERROR_STOP: case ST_SYNC_ALL: \ + case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ + case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \ + case ST_ERROR_STOP: case ST_SYNC_ALL: \ case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ - case ST_EVENT_POST: case ST_EVENT_WAIT: \ + case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \ case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \ case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA @@ -1451,7 +1526,9 @@ next_statement (void) case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: \ case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_DISTRIBUTE: \ case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO: \ - case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: \ + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_PARALLEL: \ + case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: \ + case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \ case ST_CRITICAL: \ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \ @@ -1751,6 +1828,9 @@ gfc_ascii_statement (gfc_statement st) case ST_EVENT_WAIT: p = "EVENT WAIT"; break; + case ST_FAIL_IMAGE: + p = "FAIL IMAGE"; + break; case ST_END_ASSOCIATE: p = "END ASSOCIATE"; break; @@ -2048,10 +2128,10 @@ gfc_ascii_statement (gfc_statement st) p = "!$ACC ROUTINE"; break; case ST_OACC_ATOMIC: - p = "!ACC ATOMIC"; + p = "!$ACC ATOMIC"; break; case ST_OACC_END_ATOMIC: - p = "!ACC END ATOMIC"; + p = "!$ACC END ATOMIC"; break; case ST_OMP_ATOMIC: p = "!$OMP ATOMIC"; @@ -2158,6 +2238,18 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TARGET_DATA: p = "!$OMP END TARGET DATA"; break; + case ST_OMP_END_TARGET_PARALLEL: + p = "!$OMP END TARGET PARALLEL"; + break; + case ST_OMP_END_TARGET_PARALLEL_DO: + p = "!$OMP END TARGET PARALLEL DO"; + break; + case ST_OMP_END_TARGET_PARALLEL_DO_SIMD: + p = "!$OMP END TARGET PARALLEL DO SIMD"; + break; + case ST_OMP_END_TARGET_SIMD: + p = "!$OMP END TARGET SIMD"; + break; case ST_OMP_END_TARGET_TEAMS: p = "!$OMP END TARGET TEAMS"; break; @@ -2176,6 +2268,12 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TASKGROUP: p = "!$OMP END TASKGROUP"; break; + case ST_OMP_END_TASKLOOP: + p = "!$OMP END TASKLOOP"; + break; + case ST_OMP_END_TASKLOOP_SIMD: + p = "!$OMP END TASKLOOP SIMD"; + break; case ST_OMP_END_TEAMS: p = "!$OMP END TEAMS"; break; @@ -2201,6 +2299,7 @@ gfc_ascii_statement (gfc_statement st) p = "!$OMP MASTER"; break; case ST_OMP_ORDERED: + case ST_OMP_ORDERED_DEPEND: p = "!$OMP ORDERED"; break; case ST_OMP_PARALLEL: @@ -2236,6 +2335,24 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_TARGET_DATA: p = "!$OMP TARGET DATA"; break; + case ST_OMP_TARGET_ENTER_DATA: + p = "!$OMP TARGET ENTER DATA"; + break; + case ST_OMP_TARGET_EXIT_DATA: + p = "!$OMP TARGET EXIT DATA"; + break; + case ST_OMP_TARGET_PARALLEL: + p = "!$OMP TARGET PARALLEL"; + break; + case ST_OMP_TARGET_PARALLEL_DO: + p = "!$OMP TARGET PARALLEL DO"; + break; + case ST_OMP_TARGET_PARALLEL_DO_SIMD: + p = "!$OMP TARGET PARALLEL DO SIMD"; + break; + case ST_OMP_TARGET_SIMD: + p = "!$OMP TARGET SIMD"; + break; case ST_OMP_TARGET_TEAMS: p = "!$OMP TARGET TEAMS"; break; @@ -2260,6 +2377,12 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_TASKGROUP: p = "!$OMP TASKGROUP"; break; + case ST_OMP_TASKLOOP: + p = "!$OMP TASKLOOP"; + break; + case ST_OMP_TASKLOOP_SIMD: + p = "!$OMP TASKLOOP SIMD"; + break; case ST_OMP_TASKWAIT: p = "!$OMP TASKWAIT"; break; @@ -2405,16 +2528,13 @@ accept_statement (gfc_statement st) } -/* Undo anything tentative that has been built for the current - statement. */ +/* Undo anything tentative that has been built for the current statement, + except if a gfc_charlen structure has been added to current namespace's + list of gfc_charlen structure. */ static void reject_statement (void) { - /* Revert to the previous charlen chain. */ - gfc_free_charlen (gfc_current_ns->cl_list, gfc_current_ns->old_cl_list); - gfc_current_ns->cl_list = gfc_current_ns->old_cl_list; - gfc_free_equiv_until (gfc_current_ns->equiv, gfc_current_ns->old_equiv); gfc_current_ns->equiv = gfc_current_ns->old_equiv; @@ -2801,7 +2921,7 @@ check_component (gfc_symbol *sym, gfc_component *c, gfc_component **lockp, coarray = true; sym->attr.coarray_comp = 1; } - + if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp && !c->attr.pointer) { @@ -2965,7 +3085,7 @@ parse_union (void) /* Add a component to the union for each map. */ if (!gfc_add_component (un, gfc_new_block->name, &c)) { - gfc_internal_error ("failed to create map component '%s'", + gfc_internal_error ("failed to create map component '%s'", gfc_new_block->name); reject_statement (); return; @@ -3565,17 +3685,18 @@ loop: /* Fortran 2008, C1116. */ switch (st) { - case ST_DATA_DECL: + case ST_ATTR_DECL: case ST_COMMON: case ST_DATA: - case ST_TYPE: + case ST_DATA_DECL: + case ST_DERIVED_DECL: case ST_END_BLOCK_DATA: - case ST_ATTR_DECL: case ST_EQUIVALENCE: - case ST_PARAMETER: case ST_IMPLICIT: case ST_IMPLICIT_NONE: - case ST_DERIVED_DECL: + case ST_PARAMETER: + case ST_STRUCTURE_DECL: + case ST_TYPE: case ST_USE: break; @@ -4073,6 +4194,7 @@ parse_select_type_block (void) gfc_code *cp; gfc_state_data s; + gfc_current_ns = new_st.ext.block.ns; accept_statement (ST_SELECT_TYPE); cp = gfc_state_stack->tail; @@ -4222,8 +4344,8 @@ parse_critical_block (void) for (sd = gfc_state_stack; sd; sd = sd->previous) if (sd->state == COMP_OMP_STRUCTURED_BLOCK) gfc_error_now (is_oacc (sd) - ? "CRITICAL block inside of OpenACC region at %C" - : "CRITICAL block inside of OpenMP region at %C"); + ? G_("CRITICAL block inside of OpenACC region at %C") + : G_("CRITICAL block inside of OpenMP region at %C")); s.ext.end_do_label = new_st.label1; @@ -4633,6 +4755,13 @@ parse_omp_do (gfc_statement omp_st) omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD; break; case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break; + case ST_OMP_TARGET_PARALLEL_DO: + omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO; + break; + case ST_OMP_TARGET_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO_SIMD; + break; + case ST_OMP_TARGET_SIMD: omp_end_st = ST_OMP_END_TARGET_SIMD; break; case ST_OMP_TARGET_TEAMS_DISTRIBUTE: omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE; break; @@ -4645,6 +4774,8 @@ parse_omp_do (gfc_statement omp_st) case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD; break; + case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break; + case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break; case ST_OMP_TEAMS_DISTRIBUTE: omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE; break; @@ -4701,6 +4832,7 @@ parse_omp_oacc_atomic (bool omp_p) np = new_level (cp); np->op = cp->op; np->block = NULL; + np->ext.omp_atomic = cp->ext.omp_atomic; count = 1 + ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) == GFC_OMP_ATOMIC_CAPTURE); @@ -5053,13 +5185,15 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case EXEC_OMP_END_NOWAIT: cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool; break; - case EXEC_OMP_CRITICAL: - if (((cp->ext.omp_name == NULL) ^ (new_st.ext.omp_name == NULL)) + case EXEC_OMP_END_CRITICAL: + if (((cp->ext.omp_clauses == NULL) ^ (new_st.ext.omp_name == NULL)) || (new_st.ext.omp_name != NULL - && strcmp (cp->ext.omp_name, new_st.ext.omp_name) != 0)) + && strcmp (cp->ext.omp_clauses->critical_name, + new_st.ext.omp_name) != 0)) gfc_error ("Name after !$omp critical and !$omp end critical does " "not match at %C"); free (CONST_CAST (char *, new_st.ext.omp_name)); + new_st.ext.omp_name = NULL; break; case EXEC_OMP_END_SINGLE: cp->ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE] @@ -5157,7 +5291,7 @@ parse_executable (gfc_statement st) break; case ST_SELECT_TYPE: - parse_select_type_block(); + parse_select_type_block (); break; case ST_DO: @@ -5202,6 +5336,7 @@ parse_executable (gfc_statement st) case ST_OMP_SINGLE: case ST_OMP_TARGET: case ST_OMP_TARGET_DATA: + case ST_OMP_TARGET_PARALLEL: case ST_OMP_TARGET_TEAMS: case ST_OMP_TEAMS: case ST_OMP_TASK: @@ -5223,10 +5358,14 @@ parse_executable (gfc_statement st) case ST_OMP_PARALLEL_DO: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_SIMD: + case ST_OMP_TARGET_PARALLEL_DO: + case ST_OMP_TARGET_PARALLEL_DO_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case ST_OMP_TASKLOOP: + case ST_OMP_TASKLOOP_SIMD: case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -5321,6 +5460,7 @@ parse_contained (int module) gfc_statement st; gfc_symbol *sym; gfc_entry_list *el; + locus old_loc; int contains_statements = 0; int seen_error = 0; @@ -5337,6 +5477,7 @@ parse_contained (int module) next: /* Process the next available statement. We come here if we got an error and rejected the last statement. */ + old_loc = gfc_current_locus; st = next_statement (); switch (st) @@ -5442,7 +5583,7 @@ parse_contained (int module) pop_state (); if (!contains_statements) gfc_notify_std (GFC_STD_F2008, "CONTAINS statement without " - "FUNCTION or SUBROUTINE statement at %C"); + "FUNCTION or SUBROUTINE statement at %L", &old_loc); } @@ -5462,11 +5603,11 @@ get_modproc_result (void) proc = gfc_current_ns->proc_name ? gfc_current_ns->proc_name : NULL; if (proc != NULL && proc->attr.function - && proc->ts.interface - && proc->ts.interface->result - && proc->ts.interface->result != proc->ts.interface) + && proc->tlink + && proc->tlink->result + && proc->tlink->result != proc->tlink) { - gfc_copy_dummy_sym (&proc->result, proc->ts.interface->result, 1); + gfc_copy_dummy_sym (&proc->result, proc->tlink->result, 1); gfc_set_sym_referenced (proc->result); proc->result->attr.if_source = IFSRC_DECL; gfc_commit_symbol (proc->result); @@ -5672,6 +5813,9 @@ static void set_syms_host_assoc (gfc_symbol *sym) { gfc_component *c; + const char dot[2] = "."; + char parent1[GFC_MAX_SYMBOL_LEN + 1]; + char parent2[GFC_MAX_SYMBOL_LEN + 1]; if (sym == NULL) return; @@ -5679,16 +5823,32 @@ set_syms_host_assoc (gfc_symbol *sym) if (sym->attr.module_procedure) sym->attr.external = 0; -/* sym->attr.access = ACCESS_PUBLIC; */ - sym->attr.use_assoc = 0; sym->attr.host_assoc = 1; sym->attr.used_in_submodule =1; if (sym->attr.flavor == FL_DERIVED) { - for (c = sym->components; c; c = c->next) - c->attr.access = ACCESS_PUBLIC; + /* 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 + not necessary for PRIVATE symbols since they are not read from + the module. */ + memset(parent1, '\0', sizeof(parent1)); + memset(parent2, '\0', sizeof(parent2)); + strcpy (parent1, gfc_new_block->name); + strcpy (parent2, sym->module); + if (strcmp (strtok (parent1, dot), strtok (parent2, dot)) == 0) + { + for (c = sym->components; c; c = c->next) + c->attr.access = ACCESS_PUBLIC; + } + else + { + sym->attr.use_assoc = 1; + sym->attr.host_assoc = 0; + } } } @@ -5994,12 +6154,11 @@ loop: prog_locus = gfc_current_locus; push_state (&s, COMP_PROGRAM, gfc_new_block); - main_program_symbol(gfc_current_ns, gfc_new_block->name); + main_program_symbol (gfc_current_ns, gfc_new_block->name); accept_statement (st); add_global_program (); parse_progunit (ST_NONE); goto prog_units; - break; case ST_SUBROUTINE: add_global_procedure (true); @@ -6007,7 +6166,6 @@ loop: accept_statement (st); parse_progunit (ST_NONE); goto prog_units; - break; case ST_FUNCTION: add_global_procedure (false); @@ -6015,7 +6173,6 @@ loop: accept_statement (st); parse_progunit (ST_NONE); goto prog_units; - break; case ST_BLOCK_DATA: push_state (&s, COMP_BLOCK_DATA, gfc_new_block); @@ -6050,7 +6207,6 @@ loop: main_program_symbol (gfc_current_ns, "MAIN__"); parse_progunit (st); goto prog_units; - break; } /* Handle the non-program units. */ @@ -6099,14 +6255,12 @@ prog_units: pop_state (); goto loop; - done: - +done: /* Do the resolution. */ resolve_all_program_units (gfc_global_ns_list); /* Do the parse tree dump. */ - gfc_current_ns - = flag_dump_fortran_original ? gfc_global_ns_list : NULL; + gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL; for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) if (!gfc_current_ns->proc_name diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h index e8f71cf303..87b054ab4e 100644 --- a/gcc/fortran/parse.h +++ b/gcc/fortran/parse.h @@ -1,5 +1,5 @@ /* Parser header - Copyright (C) 2003-2016 Free Software Foundation, Inc. + Copyright (C) 2003-2017 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.c index c2faa0f3e1..c12dc3562d 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1,5 +1,5 @@ /* Primary expression subroutines - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -41,7 +41,6 @@ match_kind_param (int *kind, int *is_iso_c) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symbol *sym; - const char *p; match m; *is_iso_c = 0; @@ -68,8 +67,7 @@ match_kind_param (int *kind, int *is_iso_c) if (sym->value == NULL) return MATCH_NO; - p = gfc_extract_int (sym->value, kind); - if (p != NULL) + if (gfc_extract_int (sym->value, kind)) return MATCH_NO; gfc_set_sym_referenced (sym); @@ -257,7 +255,6 @@ match_hollerith_constant (gfc_expr **result) { locus old_loc; gfc_expr *e = NULL; - const char *msg; int num, pad; int i; @@ -270,12 +267,8 @@ match_hollerith_constant (gfc_expr **result) if (!gfc_notify_std (GFC_STD_LEGACY, "Hollerith constant at %C")) goto cleanup; - msg = gfc_extract_int (e, &num); - if (msg != NULL) - { - gfc_error (msg); - goto cleanup; - } + if (gfc_extract_int (e, &num, 1)) + goto cleanup; if (num == 0) { gfc_error ("Invalid Hollerith constant: %L must contain at least " @@ -483,7 +476,7 @@ backup: static match match_real_constant (gfc_expr **result, int signflag) { - int kind, count, seen_dp, seen_digits, is_iso_c; + int kind, count, seen_dp, seen_digits, is_iso_c, default_exponent; locus old_loc, temp_loc; char *p, *buffer, c, exp_char; gfc_expr *e; @@ -494,6 +487,7 @@ match_real_constant (gfc_expr **result, int signflag) e = NULL; + default_exponent = 0; count = 0; seen_dp = 0; seen_digits = 0; @@ -575,8 +569,14 @@ match_real_constant (gfc_expr **result, int signflag) if (!ISDIGIT (c)) { - gfc_error ("Missing exponent in real number at %C"); - return MATCH_ERROR; + /* With -fdec, default exponent to 0 instead of complaining. */ + if (flag_dec) + default_exponent = 1; + else + { + gfc_error ("Missing exponent in real number at %C"); + return MATCH_ERROR; + } } while (ISDIGIT (c)) @@ -597,8 +597,8 @@ done: gfc_current_locus = old_loc; gfc_gobble_whitespace (); - buffer = (char *) alloca (count + 1); - memset (buffer, '\0', count + 1); + buffer = (char *) alloca (count + default_exponent + 1); + memset (buffer, '\0', count + default_exponent + 1); p = buffer; c = gfc_next_ascii_char (); @@ -621,6 +621,8 @@ done: c = gfc_next_ascii_char (); } + if (default_exponent) + *p++ = '0'; kind = get_kind (&is_iso_c); if (kind == -1) @@ -1008,7 +1010,6 @@ match_string_constant (gfc_expr **result) locus old_locus, start_locus; gfc_symbol *sym; gfc_expr *e; - const char *q; match m; gfc_char_t c, delimiter, *p; @@ -1073,12 +1074,8 @@ match_string_constant (gfc_expr **result) if (kind == -1) { - q = gfc_extract_int (sym->value, &kind); - if (q != NULL) - { - gfc_error (q); - return MATCH_ERROR; - } + if (gfc_extract_int (sym->value, &kind, 1)) + return MATCH_ERROR; gfc_set_sym_referenced (sym); } @@ -1353,6 +1350,10 @@ match_complex_constant (gfc_expr **result) if (gfc_match_char (',') == MATCH_NO) { + /* It is possible that gfc_int2real issued a warning when + converting an integer to real. Throw this away here. */ + + gfc_clear_warning (); gfc_pop_error (&old_error); m = MATCH_NO; goto cleanup; @@ -1554,7 +1555,7 @@ match_actual_arg (gfc_expr **result) gfc_set_sym_referenced (sym); if (sym->attr.flavor == FL_NAMELIST) { - gfc_error ("Namelist '%s' can not be an argument at %L", + gfc_error ("Namelist %qs can not be an argument at %L", sym->name, &where); break; } @@ -1646,7 +1647,7 @@ match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base) } } - actual->name = gfc_get_string (name); + actual->name = gfc_get_string ("%s", name); return MATCH_YES; cleanup: @@ -1686,18 +1687,21 @@ match_arg_list_function (gfc_actual_arglist *result) result->name = "%LOC"; break; } + /* FALLTHRU */ case 'r': if (strncmp (name, "ref", 3) == 0) { result->name = "%REF"; break; } + /* FALLTHRU */ case 'v': if (strncmp (name, "val", 3) == 0) { result->name = "%VAL"; break; } + /* FALLTHRU */ default: m = MATCH_ERROR; goto cleanup; @@ -1915,15 +1919,36 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, } /* For associate names, we may not yet know whether they are arrays or not. - Thus if we have one and parentheses follow, we have to assume that it - actually is one for now. The final decision will be made at - resolution time, of course. */ - if (sym->assoc && gfc_peek_ascii_char () == '(' - && !(sym->assoc->dangling && sym->assoc->st + If the selector expression is unambiguously an array; eg. a full array + or an array section, then the associate name must be an array and we can + fix it now. Otherwise, if parentheses follow and it is not a character + type, we have to assume that it actually is one for now. The final + decision will be made at resolution, of course. */ + if (sym->assoc + && gfc_peek_ascii_char () == '(' + && sym->ts.type != BT_CLASS + && !sym->attr.dimension) + { + if ((!sym->assoc->dangling + && sym->assoc->target + && sym->assoc->target->ref + && sym->assoc->target->ref->type == REF_ARRAY + && (sym->assoc->target->ref->u.ar.type == AR_FULL + || sym->assoc->target->ref->u.ar.type == AR_SECTION)) + || + (!(sym->assoc->dangling || sym->ts.type == BT_CHARACTER) + && sym->assoc->st && sym->assoc->st->n.sym - && sym->assoc->st->n.sym->attr.dimension == 0) - && sym->ts.type != BT_CLASS) + && sym->assoc->st->n.sym->attr.dimension == 0)) + { sym->attr.dimension = 1; + if (sym->as == NULL && sym->assoc + && sym->assoc->st + && sym->assoc->st->n.sym + && sym->assoc->st->n.sym->as) + sym->as = gfc_copy_array_spec (sym->assoc->st->n.sym->as); + } + } if ((equiv_flag && gfc_peek_ascii_char () == '(') || gfc_peek_ascii_char () == '[' || sym->attr.codimension @@ -2013,7 +2038,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (m != MATCH_YES) return MATCH_ERROR; - if (sym->f2k_derived) + if (sym && sym->f2k_derived) tbp = gfc_find_typebound_proc (sym, &t, name, false, &gfc_current_locus); else tbp = NULL; @@ -2185,7 +2210,15 @@ check_substring: } } - /* F2008, C727. */ + /* F08:C611. */ + if (primary->ts.type == BT_DERIVED && primary->ref + && primary->ts.u.derived && primary->ts.u.derived->attr.abstract) + { + gfc_error ("Nonpolymorphic reference to abstract type at %C"); + return MATCH_ERROR; + } + + /* F08:C727. */ if (primary->expr_type == EXPR_PPC && gfc_is_coindexed (primary)) { gfc_error ("Coindexed procedure-pointer component at %C"); @@ -2356,6 +2389,10 @@ gfc_expr_attr (gfc_expr *e) attr.allocatable = CLASS_DATA (sym)->attr.allocatable; } } + else if (e->value.function.isym + && e->value.function.isym->transformational + && e->ts.type == BT_CLASS) + attr = CLASS_DATA (e)->attr; else attr = gfc_variable_attr (e, NULL); @@ -2373,6 +2410,181 @@ gfc_expr_attr (gfc_expr *e) } +/* Given an expression, figure out what the ultimate expression + attribute is. This routine is similar to gfc_variable_attr with + parts of gfc_expr_attr, but focuses more on the needs of + coarrays. For coarrays a codimension attribute is kind of + "infectious" being propagated once set and never cleared. + The coarray_comp is only set, when the expression refs a coarray + component. REFS_COMP is set when present to true only, when this EXPR + refs a (non-_data) component. To check whether EXPR refs an allocatable + component in a derived type coarray *refs_comp needs to be set and + coarray_comp has to false. */ + +static symbol_attribute +caf_variable_attr (gfc_expr *expr, bool in_allocate, bool *refs_comp) +{ + int dimension, codimension, pointer, allocatable, target, coarray_comp; + symbol_attribute attr; + gfc_ref *ref; + gfc_symbol *sym; + gfc_component *comp; + + if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION) + gfc_internal_error ("gfc_caf_attr(): Expression isn't a variable"); + + sym = expr->symtree->n.sym; + gfc_clear_attr (&attr); + + if (refs_comp) + *refs_comp = false; + + if (sym->ts.type == BT_CLASS && sym->attr.class_ok) + { + dimension = CLASS_DATA (sym)->attr.dimension; + codimension = CLASS_DATA (sym)->attr.codimension; + pointer = CLASS_DATA (sym)->attr.class_pointer; + allocatable = CLASS_DATA (sym)->attr.allocatable; + attr.alloc_comp = CLASS_DATA (sym)->ts.u.derived->attr.alloc_comp; + attr.pointer_comp = CLASS_DATA (sym)->ts.u.derived->attr.pointer_comp; + } + else + { + dimension = sym->attr.dimension; + codimension = sym->attr.codimension; + pointer = sym->attr.pointer; + allocatable = sym->attr.allocatable; + attr.alloc_comp = sym->ts.type == BT_DERIVED + ? sym->ts.u.derived->attr.alloc_comp : 0; + attr.pointer_comp = sym->ts.type == BT_DERIVED + ? sym->ts.u.derived->attr.pointer_comp : 0; + } + + target = coarray_comp = 0; + if (pointer || attr.proc_pointer) + target = 1; + + for (ref = expr->ref; ref; ref = ref->next) + switch (ref->type) + { + case REF_ARRAY: + + switch (ref->u.ar.type) + { + case AR_FULL: + case AR_SECTION: + dimension = 1; + break; + + case AR_ELEMENT: + /* Handle coarrays. */ + if (ref->u.ar.dimen > 0 && !in_allocate) + allocatable = pointer = 0; + break; + + case AR_UNKNOWN: + /* If any of start, end or stride is not integer, there will + already have been an error issued. */ + int errors; + gfc_get_errors (NULL, &errors); + if (errors == 0) + gfc_internal_error ("gfc_caf_attr(): Bad array reference"); + } + + break; + + case REF_COMPONENT: + comp = ref->u.c.component; + + if (comp->ts.type == BT_CLASS) + { + /* Set coarray_comp only, when this component introduces the + coarray. */ + coarray_comp = !codimension && CLASS_DATA (comp)->attr.codimension; + codimension |= CLASS_DATA (comp)->attr.codimension; + pointer = CLASS_DATA (comp)->attr.class_pointer; + allocatable = CLASS_DATA (comp)->attr.allocatable; + } + else + { + /* Set coarray_comp only, when this component introduces the + coarray. */ + coarray_comp = !codimension && comp->attr.codimension; + codimension |= comp->attr.codimension; + pointer = comp->attr.pointer; + allocatable = comp->attr.allocatable; + } + + if (refs_comp && strcmp (comp->name, "_data") != 0 + && (ref->next == NULL + || (ref->next->type == REF_ARRAY && ref->next->next == NULL))) + *refs_comp = true; + + if (pointer || attr.proc_pointer) + target = 1; + + break; + + case REF_SUBSTRING: + allocatable = pointer = 0; + break; + } + + attr.dimension = dimension; + attr.codimension = codimension; + attr.pointer = pointer; + attr.allocatable = allocatable; + attr.target = target; + attr.save = sym->attr.save; + attr.coarray_comp = coarray_comp; + + return attr; +} + + +symbol_attribute +gfc_caf_attr (gfc_expr *e, bool in_allocate, bool *refs_comp) +{ + symbol_attribute attr; + + switch (e->expr_type) + { + case EXPR_VARIABLE: + attr = caf_variable_attr (e, in_allocate, refs_comp); + break; + + case EXPR_FUNCTION: + gfc_clear_attr (&attr); + + if (e->value.function.esym && e->value.function.esym->result) + { + gfc_symbol *sym = e->value.function.esym->result; + attr = sym->attr; + if (sym->ts.type == BT_CLASS) + { + attr.dimension = CLASS_DATA (sym)->attr.dimension; + attr.pointer = CLASS_DATA (sym)->attr.class_pointer; + attr.allocatable = CLASS_DATA (sym)->attr.allocatable; + attr.alloc_comp = CLASS_DATA (sym)->ts.u.derived->attr.alloc_comp; + attr.pointer_comp = CLASS_DATA (sym)->ts.u.derived + ->attr.pointer_comp; + } + } + else if (e->symtree) + attr = caf_variable_attr (e, in_allocate, refs_comp); + else + gfc_clear_attr (&attr); + break; + + default: + gfc_clear_attr (&attr); + break; + } + + return attr; +} + + /* Match a structure constructor. The initial symbol has already been seen. */ @@ -2458,7 +2670,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, && CLASS_DATA (comp)->attr.allocatable)) { if (!gfc_notify_std (GFC_STD_F2008, "No initializer for " - "allocatable component '%qs' given in the " + "allocatable component %qs given in the " "structure constructor at %C", comp->name)) return false; } @@ -2807,9 +3019,20 @@ gfc_match_rvalue (gfc_expr **result) bool implicit_char; gfc_ref *ref; - m = gfc_match_name (name); - if (m != MATCH_YES) - return m; + m = gfc_match ("%%loc"); + if (m == MATCH_YES) + { + if (!gfc_notify_std (GFC_STD_LEGACY, "%%LOC() as an rvalue at %C")) + return MATCH_ERROR; + strncpy (name, "loc", 4); + } + + else + { + m = gfc_match_name (name); + if (m != MATCH_YES) + return m; + } /* Check if the symbol exists. */ if (gfc_find_sym_tree (name, NULL, 1, &symtree)) @@ -3076,6 +3299,15 @@ gfc_match_rvalue (gfc_expr **result) if (sym->result == NULL) sym->result = sym; + gfc_gobble_whitespace (); + /* F08:C612. */ + if (gfc_peek_ascii_char() == '%') + { + gfc_error ("The leftmost part-ref in a data-ref can not be a " + "function reference at %C"); + m = MATCH_ERROR; + } + m = MATCH_YES; break; @@ -3339,7 +3571,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) && (dt_sym = gfc_find_dt_in_generic (sym))) { if (dt_sym->attr.flavor == FL_DERIVED) - gfc_error ("Derived type '%s' cannot be used as a variable at %C", + gfc_error ("Derived type %qs cannot be used as a variable at %C", sym->name); return MATCH_ERROR; } @@ -3412,6 +3644,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) break; /* Fall through to error */ + gcc_fallthrough (); default: gfc_error ("%qs at %C is not a variable", sym->name); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 77f8c10bf7..565e02b534 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1,5 +1,5 @@ /* Perform type resolution on the various structures. - Copyright (C) 2001-2016 Free Software Foundation, Inc. + Copyright (C) 2001-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -72,9 +72,9 @@ static bool first_actual_arg = false; static int omp_workshare_flag; -/* Nonzero if we are processing a formal arglist. The corresponding function +/* True if we are processing a formal arglist. The corresponding function resets the flag each time that it is read. */ -static int formal_arg_flag = 0; +static bool formal_arg_flag = false; /* True if we are resolving a specification expression. */ static bool specification_expr = false; @@ -89,7 +89,7 @@ static bitmap_obstack labels_obstack; static bool inquiry_argument = false; -int +bool gfc_is_formal_arg (void) { return formal_arg_flag; @@ -214,27 +214,33 @@ resolve_procedure_interface (gfc_symbol *sym) if (ifc->result) { sym->ts = ifc->result->ts; + sym->attr.allocatable = ifc->result->attr.allocatable; + sym->attr.pointer = ifc->result->attr.pointer; + sym->attr.dimension = ifc->result->attr.dimension; + sym->attr.class_ok = ifc->result->attr.class_ok; + sym->as = gfc_copy_array_spec (ifc->result->as); sym->result = sym; } else - sym->ts = ifc->ts; + { + sym->ts = ifc->ts; + sym->attr.allocatable = ifc->attr.allocatable; + sym->attr.pointer = ifc->attr.pointer; + sym->attr.dimension = ifc->attr.dimension; + sym->attr.class_ok = ifc->attr.class_ok; + sym->as = gfc_copy_array_spec (ifc->as); + } sym->ts.interface = ifc; sym->attr.function = ifc->attr.function; sym->attr.subroutine = ifc->attr.subroutine; - sym->attr.allocatable = ifc->attr.allocatable; - sym->attr.pointer = ifc->attr.pointer; sym->attr.pure = ifc->attr.pure; sym->attr.elemental = ifc->attr.elemental; - sym->attr.dimension = ifc->attr.dimension; sym->attr.contiguous = ifc->attr.contiguous; sym->attr.recursive = ifc->attr.recursive; sym->attr.always_explicit = ifc->attr.always_explicit; sym->attr.ext_attr |= ifc->attr.ext_attr; sym->attr.is_bind_c = ifc->attr.is_bind_c; - sym->attr.class_ok = ifc->attr.class_ok; - /* Copy array spec. */ - sym->as = gfc_copy_array_spec (ifc->as); /* Copy char length. */ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl) { @@ -279,7 +285,7 @@ resolve_formal_arglist (gfc_symbol *proc) sym->attr.always_explicit = 1; } - formal_arg_flag = 1; + formal_arg_flag = true; for (f = proc->formal; f; f = f->next) { @@ -524,7 +530,7 @@ resolve_formal_arglist (gfc_symbol *proc) } } } - formal_arg_flag = 0; + formal_arg_flag = false; } @@ -560,6 +566,14 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) { bool t; + if (sym && sym->attr.flavor == FL_PROCEDURE + && sym->ns->parent + && sym->ns->parent->proc_name + && sym->ns->parent->proc_name->attr.flavor == FL_PROCEDURE + && !strcmp (sym->name, sym->ns->parent->proc_name->name)) + gfc_error ("Contained procedure %qs at %L has the same name as its " + "encompassing procedure", sym->name, &sym->declared_at); + /* If this namespace is not a function or an entry master function, ignore it. */ if (! sym || !(sym->attr.function || sym->attr.flavor == FL_VARIABLE) @@ -601,10 +615,11 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) gcc_assert (ns->parent && ns->parent->proc_name); module_proc = (ns->parent->proc_name->attr.flavor == FL_MODULE); - gfc_error ("Character-valued %s %qs at %L must not be" - " assumed length", - module_proc ? _("module procedure") - : _("internal function"), + gfc_error (module_proc + ? G_("Character-valued module procedure %qs at %L" + " must not be assumed length") + : G_("Character-valued internal function %qs at %L" + " must not be assumed length"), sym->name, &sym->declared_at); } } @@ -1158,6 +1173,12 @@ resolve_structure_cons (gfc_expr *expr, int init) if (!cons->expr) continue; + /* Unions use an EXPR_NULL contrived expression to tell the translation + phase to generate an initializer of the appropriate length. + Ignore it here. */ + if (cons->expr->ts.type == BT_UNION && cons->expr->expr_type == EXPR_NULL) + continue; + if (!gfc_resolve_expr (cons->expr)) { t = false; @@ -1237,31 +1258,12 @@ resolve_structure_cons (gfc_expr *expr, int init) gfc_constructor_append_expr (&cons->expr->value.constructor, para, &cons->expr->where); } + if (cons->expr->expr_type == EXPR_ARRAY) { - gfc_constructor *p; - p = gfc_constructor_first (cons->expr->value.constructor); - if (cons->expr->ts.u.cl != p->expr->ts.u.cl) - { - gfc_charlen *cl, *cl2; - - cl2 = NULL; - for (cl = gfc_current_ns->cl_list; cl; cl = cl->next) - { - if (cl == cons->expr->ts.u.cl) - break; - cl2 = cl; - } - - gcc_assert (cl); - - if (cl2) - cl2->next = cl->next; - - gfc_free_expr (cl->length); - free (cl); - } - + /* Rely on the cleanup of the namespace to deal correctly with + the old charlen. (There was a block here that attempted to + remove the charlen but broke the chain in so doing.) */ cons->expr->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); cons->expr->ts.u.cl->length_from_typespec = true; cons->expr->ts.u.cl->length = gfc_copy_expr (comp->ts.u.cl->length); @@ -1311,9 +1313,10 @@ resolve_structure_cons (gfc_expr *expr, int init) if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1, err, sizeof (err), NULL, NULL)) { - gfc_error ("Interface mismatch for procedure-pointer component " - "%qs in structure constructor at %L: %s", - comp->name, &cons->expr->where, err); + gfc_error_opt (OPT_Wargument_mismatch, + "Interface mismatch for procedure-pointer " + "component %qs in structure constructor at %L:" + " %s", comp->name, &cons->expr->where, err); return false; } } @@ -1339,7 +1342,7 @@ resolve_structure_cons (gfc_expr *expr, int init) { t = false; gfc_error ("Pointer initialization target at %L " - "must not be ALLOCATABLE ", &cons->expr->where); + "must not be ALLOCATABLE", &cons->expr->where); } if (!a.save) { @@ -2133,7 +2136,8 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) && (set_by_optional || arg->expr->rank != rank) && !(isym && isym->id == GFC_ISYM_CONVERSION)) { - gfc_warning (0, "%qs at %L is an array and OPTIONAL; IF IT IS " + gfc_warning (OPT_Wpedantic, + "%qs at %L is an array and OPTIONAL; IF IT IS " "MISSING, it cannot be the actual argument of an " "ELEMENTAL procedure unless there is a non-optional " "argument with the same rank (12.4.1.5)", @@ -2463,8 +2467,9 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, reason, sizeof(reason), NULL, NULL)) { - gfc_error ("Interface mismatch in global procedure %qs at %L: %s ", - sym->name, &sym->declared_at, reason); + gfc_error_opt (OPT_Wargument_mismatch, + "Interface mismatch in global procedure %qs at %L:" + " %s", sym->name, &sym->declared_at, reason); goto done; } @@ -2923,6 +2928,13 @@ resolve_function (gfc_expr *expr) if (gfc_is_proc_ptr_comp (expr)) return true; + /* Avoid re-resolving the arguments of caf_get, which can lead to inserting + another caf_get. */ + if (sym && sym->attr.intrinsic + && (sym->intmod_sym_id == GFC_ISYM_CAF_GET + || sym->intmod_sym_id == GFC_ISYM_CAF_SEND)) + return true; + if (sym && sym->attr.intrinsic && !gfc_resolve_intrinsic (sym, &expr->where)) return false; @@ -3515,6 +3527,88 @@ compare_shapes (gfc_expr *op1, gfc_expr *op2) return t; } +/* Convert a logical operator to the corresponding bitwise intrinsic call. + For example A .AND. B becomes IAND(A, B). */ +static gfc_expr * +logical_to_bitwise (gfc_expr *e) +{ + gfc_expr *tmp, *op1, *op2; + gfc_isym_id isym; + gfc_actual_arglist *args = NULL; + + gcc_assert (e->expr_type == EXPR_OP); + + isym = GFC_ISYM_NONE; + op1 = e->value.op.op1; + op2 = e->value.op.op2; + + switch (e->value.op.op) + { + case INTRINSIC_NOT: + isym = GFC_ISYM_NOT; + break; + case INTRINSIC_AND: + isym = GFC_ISYM_IAND; + break; + case INTRINSIC_OR: + isym = GFC_ISYM_IOR; + break; + case INTRINSIC_NEQV: + isym = GFC_ISYM_IEOR; + break; + case INTRINSIC_EQV: + /* "Bitwise eqv" is just the complement of NEQV === IEOR. + Change the old expression to NEQV, which will get replaced by IEOR, + and wrap it in NOT. */ + tmp = gfc_copy_expr (e); + tmp->value.op.op = INTRINSIC_NEQV; + tmp = logical_to_bitwise (tmp); + isym = GFC_ISYM_NOT; + op1 = tmp; + op2 = NULL; + break; + default: + gfc_internal_error ("logical_to_bitwise(): Bad intrinsic"); + } + + /* Inherit the original operation's operands as arguments. */ + args = gfc_get_actual_arglist (); + args->expr = op1; + if (op2) + { + args->next = gfc_get_actual_arglist (); + args->next->expr = op2; + } + + /* Convert the expression to a function call. */ + e->expr_type = EXPR_FUNCTION; + e->value.function.actual = args; + e->value.function.isym = gfc_intrinsic_function_by_id (isym); + e->value.function.name = e->value.function.isym->name; + e->value.function.esym = NULL; + + /* Make up a pre-resolved function call symtree if we need to. */ + if (!e->symtree || !e->symtree->n.sym) + { + gfc_symbol *sym; + gfc_get_ha_sym_tree (e->value.function.isym->name, &e->symtree); + sym = e->symtree->n.sym; + sym->result = sym; + sym->attr.flavor = FL_PROCEDURE; + sym->attr.function = 1; + sym->attr.elemental = 1; + sym->attr.pure = 1; + sym->attr.referenced = 1; + gfc_intrinsic_symbol (sym); + gfc_commit_symbol (sym); + } + + args->name = e->value.function.isym->formal->name; + if (e->value.function.isym->formal->next) + args->next->name = e->value.function.isym->formal->next->name; + + return e; +} /* Resolve an operator expression node. This can involve replacing the operation with a user defined function call. */ @@ -3535,7 +3629,7 @@ resolve_operator (gfc_expr *e) if (!gfc_resolve_expr (e->value.op.op2)) return false; - /* Fall through... */ + /* Fall through. */ case INTRINSIC_NOT: case INTRINSIC_UPLUS: @@ -3621,6 +3715,20 @@ resolve_operator (gfc_expr *e) break; } + /* Logical ops on integers become bitwise ops with -fdec. */ + else if (flag_dec + && (op1->ts.type == BT_INTEGER || op2->ts.type == BT_INTEGER)) + { + e->ts.type = BT_INTEGER; + e->ts.kind = gfc_kind_max (op1, op2); + if (op1->ts.type != e->ts.type || op1->ts.kind != e->ts.kind) + gfc_convert_type (op1, &e->ts, 1); + if (op2->ts.type != e->ts.type || op2->ts.kind != e->ts.kind) + gfc_convert_type (op2, &e->ts, 1); + e = logical_to_bitwise (e); + return resolve_function (e); + } + sprintf (msg, _("Operands of logical operator %%<%s%%> at %%L are %s/%s"), gfc_op2string (e->value.op.op), gfc_typename (&op1->ts), gfc_typename (&op2->ts)); @@ -3628,6 +3736,15 @@ resolve_operator (gfc_expr *e) goto bad_op; case INTRINSIC_NOT: + /* Logical ops on integers become bitwise ops with -fdec. */ + if (flag_dec && op1->ts.type == BT_INTEGER) + { + e->ts.type = BT_INTEGER; + e->ts.kind = op1->ts.kind; + e = logical_to_bitwise (e); + return resolve_function (e); + } + if (op1->ts.type == BT_LOGICAL) { e->ts.type = BT_LOGICAL; @@ -3653,7 +3770,7 @@ resolve_operator (gfc_expr *e) goto bad_op; } - /* Fall through... */ + /* Fall through. */ case INTRINSIC_EQ: case INTRINSIC_EQ_OS: @@ -3691,7 +3808,8 @@ resolve_operator (gfc_expr *e) else msg = "Inequality comparison for %s at %L"; - gfc_warning (0, msg, gfc_typename (&op1->ts), &op1->where); + gfc_warning (OPT_Wcompare_reals, msg, + gfc_typename (&op1->ts), &op1->where); } } @@ -5105,6 +5223,11 @@ resolve_variable (gfc_expr *e) if (sym->ts.type != BT_UNKNOWN) gfc_variable_attr (e, &e->ts); + else if (sym->attr.flavor == FL_PROCEDURE + && sym->attr.function && sym->result + && sym->result->ts.type != BT_UNKNOWN + && sym->result->attr.proc_pointer) + e->ts = sym->result->ts; else { /* Must be a simple variable reference. */ @@ -5412,14 +5535,17 @@ fixup_charlen (gfc_expr *e) { case EXPR_OP: gfc_resolve_character_operator (e); + /* FALLTHRU */ case EXPR_ARRAY: if (e->expr_type == EXPR_ARRAY) gfc_resolve_character_array_constructor (e); + /* FALLTHRU */ case EXPR_SUBSTRING: if (!e->ts.u.cl && e->ref) gfc_resolve_substring_charlen (e); + /* FALLTHRU */ default: if (!e->ts.u.cl) @@ -6004,7 +6130,7 @@ resolve_typebound_function (gfc_expr* e) gfc_free_ref_list (class_ref->next); class_ref->next = NULL; } - else if (e->ref && !class_ref) + else if (e->ref && !class_ref && expr->ts.type != BT_CLASS) { gfc_free_ref_list (e->ref); e->ref = NULL; @@ -6308,6 +6434,31 @@ gfc_is_expandable_expr (gfc_expr *e) return false; } + +/* Sometimes variables in specification expressions of the result + of module procedures in submodules wind up not being the 'real' + dummy. Find this, if possible, in the namespace of the first + formal argument. */ + +static void +fixup_unique_dummy (gfc_expr *e) +{ + gfc_symtree *st = NULL; + gfc_symbol *s = NULL; + + if (e->symtree->n.sym->ns->proc_name + && e->symtree->n.sym->ns->proc_name->formal) + s = e->symtree->n.sym->ns->proc_name->formal->sym; + + if (s != NULL) + st = gfc_find_symtree (s->ns->sym_root, e->symtree->n.sym->name); + + if (st != NULL + && st->n.sym != NULL + && st->n.sym->attr.dummy) + e->symtree = st; +} + /* Resolve an expression. That is, make sure that types of operands agree with their operators, intrinsic operators are converted to function calls for overloaded types and unresolved function references are resolved. */ @@ -6332,6 +6483,14 @@ gfc_resolve_expr (gfc_expr *e) actual_arg = false; first_actual_arg = false; } + else if (e->symtree != NULL + && *e->symtree->name == '@' + && e->symtree->n.sym->attr.dummy) + { + /* Deal with submodule specification expressions that are not + found to be referenced in module.c(read_cleanup). */ + fixup_unique_dummy (e); + } switch (e->expr_type) { @@ -6508,15 +6667,15 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope) /* Convert start, end, and step to the same type as var. */ if (iter->start->ts.kind != iter->var->ts.kind || iter->start->ts.type != iter->var->ts.type) - gfc_convert_type (iter->start, &iter->var->ts, 2); + gfc_convert_type (iter->start, &iter->var->ts, 1); if (iter->end->ts.kind != iter->var->ts.kind || iter->end->ts.type != iter->var->ts.type) - gfc_convert_type (iter->end, &iter->var->ts, 2); + gfc_convert_type (iter->end, &iter->var->ts, 1); if (iter->step->ts.kind != iter->var->ts.kind || iter->step->ts.type != iter->var->ts.type) - gfc_convert_type (iter->step, &iter->var->ts, 2); + gfc_convert_type (iter->step, &iter->var->ts, 1); if (iter->start->expr_type == EXPR_CONSTANT && iter->end->expr_type == EXPR_CONSTANT @@ -6539,6 +6698,29 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope) &iter->step->where); } + if (iter->end->expr_type == EXPR_CONSTANT + && iter->end->ts.type == BT_INTEGER + && iter->step->expr_type == EXPR_CONSTANT + && iter->step->ts.type == BT_INTEGER + && (mpz_cmp_si (iter->step->value.integer, -1L) == 0 + || mpz_cmp_si (iter->step->value.integer, 1L) == 0)) + { + bool is_step_positive = mpz_cmp_ui (iter->step->value.integer, 1) == 0; + int k = gfc_validate_kind (BT_INTEGER, iter->end->ts.kind, false); + + if (is_step_positive + && mpz_cmp (iter->end->value.integer, gfc_integer_kinds[k].huge) == 0) + gfc_warning (OPT_Wundefined_do_loop, + "DO loop at %L is undefined as it overflows", + &iter->step->where); + else if (!is_step_positive + && mpz_cmp (iter->end->value.integer, + gfc_integer_kinds[k].min_int) == 0) + gfc_warning (OPT_Wundefined_do_loop, + "DO loop at %L is undefined as it underflows", + &iter->step->where); + } + return true; } @@ -6656,6 +6838,11 @@ derived_inaccessible (gfc_symbol *sym) for (c = sym->components; c; c = c->next) { + /* Prevent an infinite loop through this function. */ + if (c->ts.type == BT_DERIVED && c->attr.pointer + && sym == c->ts.u.derived) + continue; + if (c->ts.type == BT_DERIVED && derived_inaccessible (c->ts.u.derived)) return 1; } @@ -7140,41 +7327,6 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec) /* We have to zero initialize the integer variable. */ code->expr3 = gfc_get_int_expr (gfc_default_integer_kind, &e->where, 0); } - else if (!code->expr3) - { - /* Set up default initializer if needed. */ - gfc_typespec ts; - gfc_expr *init_e; - - if (gfc_bt_struct (code->ext.alloc.ts.type)) - ts = code->ext.alloc.ts; - else - ts = e->ts; - - if (ts.type == BT_CLASS) - ts = ts.u.derived->components->ts; - - if (gfc_bt_struct (ts.type) && (init_e = gfc_default_initializer (&ts))) - { - gfc_code *init_st = gfc_get_code (EXEC_INIT_ASSIGN); - init_st->loc = code->loc; - init_st->expr1 = gfc_expr_to_initialize (e); - init_st->expr2 = init_e; - init_st->next = code->next; - code->next = init_st; - } - } - else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED) - { - /* Default initialization via MOLD (non-polymorphic). */ - gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts); - if (rhs != NULL) - { - gfc_resolve_expr (rhs); - gfc_free_expr (code->expr3); - code->expr3 = rhs; - } - } if (e->ts.type == BT_CLASS && !unlimited && !UNLIMITED_POLY (code->expr3)) { @@ -7186,10 +7338,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec) else if (code->ext.alloc.ts.type == BT_DERIVED) ts = code->ext.alloc.ts; + /* Finding the vtab also publishes the type's symbol. Therefore this + statement is necessary. */ gfc_find_derived_vtab (ts.u.derived); - - if (dimension) - e = gfc_expr_to_initialize (e); } else if (unlimited && !UNLIMITED_POLY (code->expr3)) { @@ -7203,10 +7354,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec) gcc_assert (ts); + /* Finding the vtab also publishes the type's symbol. Therefore this + statement is necessary. */ gfc_find_vtab (ts); - - if (dimension) - e = gfc_expr_to_initialize (e); } if (dimension == 0 && codimension == 0) @@ -7271,7 +7421,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec) && ar->stride[i] == NULL) break; - /* Fall Through... */ + /* Fall through. */ case DIMEN_UNKNOWN: case DIMEN_VECTOR: @@ -7510,6 +7660,22 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) if (strcmp (fcn, "ALLOCATE") == 0) { bool arr_alloc_wo_spec = false; + + /* Resolving the expr3 in the loop over all objects to allocate would + execute loop invariant code for each loop item. Therefore do it just + once here. */ + if (code->expr3 && code->expr3->mold + && code->expr3->ts.type == BT_DERIVED) + { + /* Default initialization via MOLD (non-polymorphic). */ + gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts); + if (rhs != NULL) + { + gfc_resolve_expr (rhs); + gfc_free_expr (code->expr3); + code->expr3 = rhs; + } + } for (a = code->ext.alloc.list; a; a = a->next) resolve_allocate_expr (a->expr, code, &arr_alloc_wo_spec); @@ -8244,12 +8410,86 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) /* Mark this as an associate variable. */ sym->attr.associate_var = 1; + /* Fix up the type-spec for CHARACTER types. */ + if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary) + { + if (!sym->ts.u.cl) + sym->ts.u.cl = target->ts.u.cl; + + if (!sym->ts.u.cl->length) + sym->ts.u.cl->length + = gfc_get_int_expr (gfc_default_integer_kind, + NULL, target->value.character.length); + } + /* If the target is a good class object, so is the associate variable. */ if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok) sym->attr.class_ok = 1; } +/* Ensure that SELECT TYPE expressions have the correct rank and a full + array reference, where necessary. The symbols are artificial and so + the dimension attribute and arrayspec can also be set. In addition, + sometimes the expr1 arrives as BT_DERIVED, when the symbol is BT_CLASS. + This is corrected here as well.*/ + +static void +fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2, + int rank, gfc_ref *ref) +{ + gfc_ref *nref = (*expr1)->ref; + gfc_symbol *sym1 = (*expr1)->symtree->n.sym; + gfc_symbol *sym2 = expr2 ? expr2->symtree->n.sym : NULL; + (*expr1)->rank = rank; + if (sym1->ts.type == BT_CLASS) + { + if ((*expr1)->ts.type != BT_CLASS) + (*expr1)->ts = sym1->ts; + + CLASS_DATA (sym1)->attr.dimension = 1; + if (CLASS_DATA (sym1)->as == NULL && sym2) + CLASS_DATA (sym1)->as + = gfc_copy_array_spec (CLASS_DATA (sym2)->as); + } + else + { + sym1->attr.dimension = 1; + if (sym1->as == NULL && sym2) + sym1->as = gfc_copy_array_spec (sym2->as); + } + + for (; nref; nref = nref->next) + if (nref->next == NULL) + break; + + if (ref && nref && nref->type != REF_ARRAY) + nref->next = gfc_copy_ref (ref); + else if (ref && !nref) + (*expr1)->ref = gfc_copy_ref (ref); +} + + +static gfc_expr * +build_loc_call (gfc_expr *sym_expr) +{ + gfc_expr *loc_call; + loc_call = gfc_get_expr (); + loc_call->expr_type = EXPR_FUNCTION; + gfc_get_sym_tree ("loc", gfc_current_ns, &loc_call->symtree, false); + loc_call->symtree->n.sym->attr.flavor = FL_PROCEDURE; + loc_call->symtree->n.sym->attr.intrinsic = 1; + loc_call->symtree->n.sym->result = loc_call->symtree->n.sym; + gfc_commit_symbol (loc_call->symtree->n.sym); + loc_call->ts.type = BT_INTEGER; + loc_call->ts.kind = gfc_index_integer_kind; + loc_call->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_LOC); + loc_call->value.function.actual = gfc_get_actual_arglist (); + loc_call->value.function.actual->expr = sym_expr; + loc_call->where = sym_expr->where; + return loc_call; +} + /* Resolve a SELECT TYPE statement. */ static void @@ -8264,6 +8504,9 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) gfc_namespace *ns; int error = 0; int charlen = 0; + int rank = 0; + gfc_ref* ref = NULL; + gfc_expr *selector_expr = NULL; ns = code->ext.block.ns; gfc_resolve (ns); @@ -8312,6 +8555,31 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) { c = body->ext.block.case_list; + if (!error) + { + /* Check for repeated cases. */ + for (tail = code->block; tail; tail = tail->block) + { + gfc_case *d = tail->ext.block.case_list; + if (tail == body) + break; + + if (c->ts.type == d->ts.type + && ((c->ts.type == BT_DERIVED + && c->ts.u.derived && d->ts.u.derived + && !strcmp (c->ts.u.derived->name, + d->ts.u.derived->name)) + || c->ts.type == BT_UNKNOWN + || (!(c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + && c->ts.kind == d->ts.kind))) + { + gfc_error ("TYPE IS at %L overlaps with TYPE IS at %L", + &c->where, &d->where); + return; + } + } + } + /* Check F03:C815. */ if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) && !selector_type->attr.unlimited_polymorphic @@ -8339,7 +8607,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) } /* Check F03:C814. */ - if (c->ts.type == BT_CHARACTER && c->ts.u.cl->length != NULL) + if (c->ts.type == BT_CHARACTER + && (c->ts.u.cl->length != NULL || c->ts.deferred)) { gfc_error ("The type-spec at %L shall specify that each length " "type parameter is assumed", &c->where); @@ -8391,6 +8660,31 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) else code->ext.block.assoc = NULL; + /* Ensure that the selector rank and arrayspec are available to + correct expressions in which they might be missing. */ + if (code->expr2 && code->expr2->rank) + { + rank = code->expr2->rank; + for (ref = code->expr2->ref; ref; ref = ref->next) + if (ref->next == NULL) + break; + if (ref && ref->type == REF_ARRAY) + ref = gfc_copy_ref (ref); + + /* Fixup expr1 if necessary. */ + if (rank) + fixup_array_ref (&code->expr1, code->expr2, rank, ref); + } + else if (code->expr1->rank) + { + rank = code->expr1->rank; + for (ref = code->expr1->ref; ref; ref = ref->next) + if (ref->next == NULL) + break; + if (ref && ref->type == REF_ARRAY) + ref = gfc_copy_ref (ref); + } + /* Add EXEC_SELECT to switch on type. */ new_st = gfc_get_code (code->op); new_st->expr1 = code->expr1; @@ -8403,31 +8697,47 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) else ns->code->next = new_st; code = new_st; - code->op = EXEC_SELECT; + code->op = EXEC_SELECT_TYPE; + /* Use the intrinsic LOC function to generate an integer expression + for the vtable of the selector. Note that the rank of the selector + expression has to be set to zero. */ gfc_add_vptr_component (code->expr1); - gfc_add_hash_component (code->expr1); + code->expr1->rank = 0; + code->expr1 = build_loc_call (code->expr1); + selector_expr = code->expr1->value.function.actual->expr; /* Loop over TYPE IS / CLASS IS cases. */ for (body = code->block; body; body = body->block) { + gfc_symbol *vtab; + gfc_expr *e; c = body->ext.block.case_list; - if (c->ts.type == BT_DERIVED) - c->low = c->high = gfc_get_int_expr (gfc_default_integer_kind, NULL, - c->ts.u.derived->hash_value); - else if (c->ts.type != BT_CLASS && c->ts.type != BT_UNKNOWN) + /* Generate an index integer expression for address of the + TYPE/CLASS vtable and store it in c->low. The hash expression + is stored in c->high and is used to resolve intrinsic cases. */ + if (c->ts.type != BT_UNKNOWN) { - gfc_symbol *ivtab; - gfc_expr *e; + if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + { + vtab = gfc_find_derived_vtab (c->ts.u.derived); + gcc_assert (vtab); + c->high = gfc_get_int_expr (gfc_default_integer_kind, NULL, + c->ts.u.derived->hash_value); + } + else + { + vtab = gfc_find_vtab (&c->ts); + gcc_assert (vtab && CLASS_DATA (vtab)->initializer); + e = CLASS_DATA (vtab)->initializer; + c->high = gfc_copy_expr (e); + } - ivtab = gfc_find_vtab (&c->ts); - gcc_assert (ivtab && CLASS_DATA (ivtab)->initializer); - e = CLASS_DATA (ivtab)->initializer; - c->low = c->high = gfc_copy_expr (e); + e = gfc_lval_expr_from_sym (vtab); + c->low = build_loc_call (e); } - - else if (c->ts.type == BT_UNKNOWN) + else continue; /* Associate temporary to selector. This should only be done @@ -8453,10 +8763,15 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) st = gfc_find_symtree (ns->sym_root, name); gcc_assert (st->n.sym->assoc); - st->n.sym->assoc->target = gfc_get_variable_expr (code->expr1->symtree); - st->n.sym->assoc->target->where = code->expr1->where; + st->n.sym->assoc->target = gfc_get_variable_expr (selector_expr->symtree); + st->n.sym->assoc->target->where = selector_expr->where; if (c->ts.type != BT_CLASS && c->ts.type != BT_UNKNOWN) - gfc_add_data_component (st->n.sym->assoc->target); + { + gfc_add_data_component (st->n.sym->assoc->target); + /* Fixup the target expression if necessary. */ + if (rank) + fixup_array_ref (&st->n.sym->assoc->target, NULL, rank, ref); + } new_st = gfc_get_code (EXEC_BLOCK); new_st->ext.block.ns = gfc_build_block_ns (ns); @@ -8569,13 +8884,15 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) new_st->expr1->value.function.isym->id = GFC_ISYM_EXTENDS_TYPE_OF; /* Set up arguments. */ new_st->expr1->value.function.actual = gfc_get_actual_arglist (); - new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (code->expr1->symtree); + new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (selector_expr->symtree); new_st->expr1->value.function.actual->expr->where = code->loc; + new_st->expr1->where = code->loc; gfc_add_vptr_component (new_st->expr1->value.function.actual->expr); vtab = gfc_find_derived_vtab (body->ext.block.case_list->ts.u.derived); st = gfc_find_symtree (vtab->ns->sym_root, vtab->name); new_st->expr1->value.function.actual->next = gfc_get_actual_arglist (); new_st->expr1->value.function.actual->next->expr = gfc_get_variable_expr (st); + new_st->expr1->value.function.actual->next->expr->where = code->loc; new_st->next = body->next; } if (default_case->next) @@ -8595,7 +8912,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) gfc_resolve_blocks (code->block, gfc_current_ns); gfc_current_ns = old_ns; - resolve_select (code, true); + if (ref) + free (ref); } @@ -8609,9 +8927,13 @@ static void resolve_transfer (gfc_code *code) { gfc_typespec *ts; - gfc_symbol *sym; + gfc_symbol *sym, *derived; gfc_ref *ref; gfc_expr *exp; + bool write = false; + bool formatted = false; + gfc_dt *dt = code->ext.dt; + gfc_symbol *dtio_sub = NULL; exp = code->expr1; @@ -8635,7 +8957,7 @@ resolve_transfer (gfc_code *code) /* If we are reading, the variable will be changed. Note that code->ext.dt may be NULL if the TRANSFER is related to an INQUIRE statement -- but in this case, we are not reading, either. */ - if (code->ext.dt && code->ext.dt->dt_io_kind->value.iokind == M_READ + if (dt && dt->dt_io_kind->value.iokind == M_READ && !gfc_check_vardef_context (exp, false, false, false, _("item in READ"))) return; @@ -8647,9 +8969,54 @@ resolve_transfer (gfc_code *code) if (ref->type == REF_COMPONENT) ts = &ref->u.c.component->ts; - if (ts->type == BT_CLASS) + if (dt && dt->dt_io_kind->value.iokind != M_INQUIRE + && (ts->type == BT_DERIVED || ts->type == BT_CLASS)) + { + if (ts->type == BT_DERIVED) + derived = ts->u.derived; + else + derived = ts->u.derived->components->ts.u.derived; + + if (dt->format_expr) + { + char *fmt; + fmt = gfc_widechar_to_char (dt->format_expr->value.character.string, + -1); + if (strtok (fmt, "DT") != NULL) + formatted = true; + } + else if (dt->format_label == &format_asterisk) + { + /* List directed io must call the formatted DTIO procedure. */ + formatted = true; + } + + write = dt->dt_io_kind->value.iokind == M_WRITE + || dt->dt_io_kind->value.iokind == M_PRINT; + dtio_sub = gfc_find_specific_dtio_proc (derived, write, formatted); + + if (dtio_sub != NULL && exp->expr_type == EXPR_VARIABLE) + { + dt->udtio = exp; + sym = exp->symtree->n.sym->ns->proc_name; + /* Check to see if this is a nested DTIO call, with the + dummy as the io-list object. */ + if (sym && sym == dtio_sub && sym->formal + && sym->formal->sym == exp->symtree->n.sym + && exp->ref == NULL) + { + if (!sym->attr.recursive) + { + gfc_error ("DTIO %s procedure at %L must be recursive", + sym->name, &sym->declared_at); + return; + } + } + } + } + + if (ts->type == BT_CLASS && dtio_sub == NULL) { - /* FIXME: Test for defined input/output. */ gfc_error ("Data transfer element at %L cannot be polymorphic unless " "it is processed by a defined input/output procedure", &code->loc); @@ -8659,8 +9026,9 @@ resolve_transfer (gfc_code *code) if (ts->type == BT_DERIVED) { /* Check that transferred derived type doesn't contain POINTER - components. */ - if (ts->u.derived->attr.pointer_comp) + components unless it is processed by a defined input/output + procedure". */ + if (ts->u.derived->attr.pointer_comp && dtio_sub == NULL) { gfc_error ("Data transfer element at %L cannot have POINTER " "components unless it is processed by a defined " @@ -8676,7 +9044,7 @@ resolve_transfer (gfc_code *code) return; } - if (ts->u.derived->attr.alloc_comp) + if (ts->u.derived->attr.alloc_comp && dtio_sub == NULL) { gfc_error ("Data transfer element at %L cannot have ALLOCATABLE " "components unless it is processed by a defined " @@ -8693,10 +9061,11 @@ resolve_transfer (gfc_code *code) "cannot have PRIVATE components", &code->loc)) return; } - else if (derived_inaccessible (ts->u.derived)) + else if (derived_inaccessible (ts->u.derived) && dtio_sub == NULL) { gfc_error ("Data transfer element at %L cannot have " - "PRIVATE components",&code->loc); + "PRIVATE components unless it is processed by " + "a defined input/output procedure", &code->loc); return; } } @@ -8823,10 +9192,13 @@ resolve_lock_unlock_event (gfc_code *code) return; /* Check for EVENT WAIT the UNTIL_COUNT. */ - if (code->op == EXEC_EVENT_WAIT && code->expr4 - && (code->expr4->ts.type != BT_INTEGER || code->expr4->rank != 0)) - gfc_error ("UNTIL_COUNT= argument at %L must be a scalar INTEGER " - "expression", &code->expr4->where); + if (code->op == EXEC_EVENT_WAIT && code->expr4) + { + if (!gfc_resolve_expr (code->expr4) || code->expr4->ts.type != BT_INTEGER + || code->expr4->rank != 0) + gfc_error ("UNTIL_COUNT= argument at %L must be a scalar INTEGER " + "expression", &code->expr4->where); + } } @@ -8936,7 +9308,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code) if (label->defined == ST_LABEL_UNKNOWN) { gfc_error ("Label %d referenced at %L is never defined", label->value, - &label->where); + &code->loc); return; } @@ -9301,16 +9673,15 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save) static gfc_expr **var_expr; static int total_var = 0; static int nvar = 0; - int old_nvar, tmp; + int i, old_nvar, tmp; gfc_forall_iterator *fa; - int i; old_nvar = nvar; /* Start to resolve a FORALL construct */ if (forall_save == 0) { - /* Count the total number of FORALL index in the nested FORALL + /* Count the total number of FORALL indices in the nested FORALL construct in order to allocate the VAR_EXPR with proper size. */ total_var = gfc_count_forall_iterators (code); @@ -9318,19 +9689,25 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save) var_expr = XCNEWVEC (gfc_expr *, total_var); } - /* The information about FORALL iterator, including FORALL index start, end - and stride. The FORALL index can not appear in start, end or stride. */ + /* The information about FORALL iterator, including FORALL indices start, end + and stride. An outer FORALL indice cannot appear in start, end or stride. */ for (fa = code->ext.forall_iterator; fa; fa = fa->next) { + /* Fortran 20008: C738 (R753). */ + if (fa->var->ref && fa->var->ref->type == REF_ARRAY) + { + gfc_error ("FORALL index-name at %L must be a scalar variable " + "of type integer", &fa->var->where); + continue; + } + /* Check if any outer FORALL index name is the same as the current one. */ for (i = 0; i < nvar; i++) { if (fa->var->symtree->n.sym == var_expr[i]->symtree->n.sym) - { - gfc_error ("An outer FORALL construct already has an index " - "with this name %L", &fa->var->where); - } + gfc_error ("An outer FORALL construct already has an index " + "with this name %L", &fa->var->where); } /* Record the current FORALL index. */ @@ -9431,6 +9808,24 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_WAIT: break; + case EXEC_OMP_ATOMIC: + case EXEC_OACC_ATOMIC: + { + gfc_omp_atomic_op aop + = (gfc_omp_atomic_op) (b->ext.omp_atomic & GFC_OMP_ATOMIC_MASK); + + /* Verify this before calling gfc_resolve_code, which might + change it. */ + gcc_assert (b->next && b->next->op == EXEC_ASSIGN); + gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE) + && b->next->next == NULL) + || ((aop == GFC_OMP_ATOMIC_CAPTURE) + && b->next->next != NULL + && b->next->next->op == EXEC_ASSIGN + && b->next->next->next == NULL)); + } + break; + case EXEC_OACC_PARALLEL_LOOP: case EXEC_OACC_PARALLEL: case EXEC_OACC_KERNELS_LOOP: @@ -9443,9 +9838,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: - case EXEC_OACC_ATOMIC: case EXEC_OACC_ROUTINE: - case EXEC_OMP_ATOMIC: case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: @@ -9465,6 +9858,12 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -9473,6 +9872,8 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_TEAMS: @@ -9690,10 +10091,6 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) "requires %<-frealloc-lhs%>", &lhs->where); return false; } - /* See PR 43366. */ - gfc_error ("Assignment to an allocatable polymorphic variable at %L " - "is not yet supported", &lhs->where); - return false; } else if (lhs->ts.type == BT_CLASS) { @@ -9713,27 +10110,29 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) return false; } - gfc_check_assign (lhs, rhs, 1); - /* Assign the 'data' of a class object to a derived type. */ if (lhs->ts.type == BT_DERIVED && rhs->ts.type == BT_CLASS) gfc_add_data_component (rhs); - /* Insert a GFC_ISYM_CAF_SEND intrinsic, when the LHS is a coindexed variable. - Additionally, insert this code when the RHS is a CAF as we then use the - GFC_ISYM_CAF_SEND intrinsic just to avoid a temporary; but do not do so if - the LHS is (re)allocatable or has a vector subscript. If the LHS is a - noncoindexed array and the RHS is a coindexed scalar, use the normal code - path. */ - if (flag_coarray == GFC_FCOARRAY_LIB + bool caf_convert_to_send = flag_coarray == GFC_FCOARRAY_LIB && (lhs_coindexed || (code->expr2->expr_type == EXPR_FUNCTION && code->expr2->value.function.isym && code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET && (code->expr1->rank == 0 || code->expr2->rank != 0) && !gfc_expr_attr (rhs).allocatable - && !gfc_has_vector_subscript (rhs)))) + && !gfc_has_vector_subscript (rhs))); + + gfc_check_assign (lhs, rhs, 1, !caf_convert_to_send); + + /* Insert a GFC_ISYM_CAF_SEND intrinsic, when the LHS is a coindexed variable. + Additionally, insert this code when the RHS is a CAF as we then use the + GFC_ISYM_CAF_SEND intrinsic just to avoid a temporary; but do not do so if + the LHS is (re)allocatable or has a vector subscript. If the LHS is a + noncoindexed array and the RHS is a coindexed scalar, use the normal code + path. */ + if (caf_convert_to_send) { if (code->expr2->expr_type == EXPR_FUNCTION && code->expr2->value.function.isym @@ -10390,6 +10789,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -10410,6 +10812,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: gfc_resolve_omp_do_blocks (code, ns); break; case EXEC_SELECT_TYPE: @@ -10479,6 +10884,9 @@ start: resolve_lock_unlock_event (code); break; + case EXEC_FAIL_IMAGE: + break; + case EXEC_ENTRY: /* Keep track of which entry we are up to. */ current_entry_id = code->ext.entry->id; @@ -10594,6 +11002,19 @@ start: break; gfc_check_pointer_assign (code->expr1, code->expr2); + + /* Assigning a class object always is a regular assign. */ + if (code->expr2->ts.type == BT_CLASS + && !CLASS_DATA (code->expr2)->attr.dimension + && !(UNLIMITED_POLY (code->expr2) + && code->expr1->ts.type == BT_DERIVED + && (code->expr1->ts.u.derived->attr.sequence + || code->expr1->ts.u.derived->attr.is_bind_c)) + && !(gfc_expr_attr (code->expr1).proc_pointer + && code->expr2->expr_type == EXPR_VARIABLE + && code->expr2->symtree->n.sym->attr.flavor + == FL_PROCEDURE)) + code->op = EXEC_ASSIGN; break; } @@ -10792,6 +11213,12 @@ start: case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -10800,6 +11227,8 @@ start: case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_TEAMS: @@ -10868,6 +11297,21 @@ resolve_bind_c_derived_types (gfc_symbol *derived_sym) } +/* Check the interfaces of DTIO procedures associated with derived + type 'sym'. These procedures can either have typebound bindings or + can appear in DTIO generic interfaces. */ + +static void +gfc_verify_DTIO_procedures (gfc_symbol *sym) +{ + if (!sym || sym->attr.flavor != FL_DERIVED) + return; + + gfc_check_dtio_interfaces (sym); + + return; +} + /* Verify that any binding labels used in a given namespace do not collide with the names or binding labels of any global symbols. Multiple INTERFACE for the same procedure are permitted. */ @@ -11105,6 +11549,39 @@ build_init_assign (gfc_symbol *sym, gfc_expr *init) init_st->expr2 = init; } + +/* Whether or not we can generate a default initializer for a symbol. */ + +static bool +can_generate_init (gfc_symbol *sym) +{ + symbol_attribute *a; + if (!sym) + return false; + a = &sym->attr; + + /* These symbols should never have a default initialization. */ + return !( + a->allocatable + || a->external + || a->pointer + || (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && (CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym)->attr.proc_pointer)) + || a->in_equivalence + || a->in_common + || a->data + || sym->module + || a->cray_pointee + || a->cray_pointer + || sym->assoc + || (!a->referenced && !a->result) + || (a->dummy && a->intent != INTENT_OUT) + || (a->function && sym != sym->result) + ); +} + + /* Assign the default initializer to a derived type variable or result. */ static void @@ -11116,7 +11593,7 @@ apply_default_init (gfc_symbol *sym) return; if (sym->ts.type == BT_DERIVED && sym->ts.u.derived) - init = gfc_default_initializer (&sym->ts); + init = gfc_generate_initializer (&sym->ts, can_generate_init (sym)); if (init == NULL && sym->ts.type != BT_CLASS) return; @@ -11125,17 +11602,13 @@ apply_default_init (gfc_symbol *sym) sym->attr.referenced = 1; } -/* 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-runtime. Returns - null if the symbol should not have a default initialization. */ + +/* Build an initializer for a local. Returns null if the symbol should not have + a default initialization. */ + static gfc_expr * build_default_init_expr (gfc_symbol *sym) { - int char_len; - gfc_expr *init_expr; - int i; - /* These symbols should never have a default initialization. */ if (sym->attr.allocatable || sym->attr.external @@ -11150,145 +11623,8 @@ build_default_init_expr (gfc_symbol *sym) || sym->assoc) return NULL; - /* Now we'll try to build an initializer expression. */ - init_expr = gfc_get_constant_expr (sym->ts.type, sym->ts.kind, - &sym->declared_at); - - /* We will only initialize integers, reals, complex, logicals, and - characters, and only if the corresponding command-line flags - were set. Otherwise, we free init_expr and return null. */ - switch (sym->ts.type) - { - case BT_INTEGER: - if (gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF) - mpz_set_si (init_expr->value.integer, - gfc_option.flag_init_integer_value); - else - { - gfc_free_expr (init_expr); - init_expr = NULL; - } - break; - - case BT_REAL: - switch (flag_init_real) - { - case GFC_INIT_REAL_SNAN: - init_expr->is_snan = 1; - /* Fall through. */ - case GFC_INIT_REAL_NAN: - mpfr_set_nan (init_expr->value.real); - break; - - case GFC_INIT_REAL_INF: - mpfr_set_inf (init_expr->value.real, 1); - break; - - case GFC_INIT_REAL_NEG_INF: - mpfr_set_inf (init_expr->value.real, -1); - break; - - case GFC_INIT_REAL_ZERO: - mpfr_set_ui (init_expr->value.real, 0.0, GFC_RND_MODE); - break; - - default: - gfc_free_expr (init_expr); - init_expr = NULL; - break; - } - break; - - case BT_COMPLEX: - switch (flag_init_real) - { - case GFC_INIT_REAL_SNAN: - init_expr->is_snan = 1; - /* Fall through. */ - case GFC_INIT_REAL_NAN: - mpfr_set_nan (mpc_realref (init_expr->value.complex)); - mpfr_set_nan (mpc_imagref (init_expr->value.complex)); - break; - - case GFC_INIT_REAL_INF: - mpfr_set_inf (mpc_realref (init_expr->value.complex), 1); - mpfr_set_inf (mpc_imagref (init_expr->value.complex), 1); - break; - - case GFC_INIT_REAL_NEG_INF: - mpfr_set_inf (mpc_realref (init_expr->value.complex), -1); - mpfr_set_inf (mpc_imagref (init_expr->value.complex), -1); - break; - - case GFC_INIT_REAL_ZERO: - mpc_set_ui (init_expr->value.complex, 0, GFC_MPC_RND_MODE); - break; - - default: - gfc_free_expr (init_expr); - init_expr = NULL; - break; - } - break; - - case BT_LOGICAL: - if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_FALSE) - init_expr->value.logical = 0; - else if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_TRUE) - init_expr->value.logical = 1; - else - { - gfc_free_expr (init_expr); - init_expr = NULL; - } - break; - - case BT_CHARACTER: - /* For characters, the length must be constant in order to - create a default initializer. */ - if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON - && sym->ts.u.cl->length - && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT) - { - char_len = mpz_get_si (sym->ts.u.cl->length->value.integer); - init_expr->value.character.length = char_len; - init_expr->value.character.string = gfc_get_wide_string (char_len+1); - for (i = 0; i < char_len; i++) - init_expr->value.character.string[i] - = (unsigned char) gfc_option.flag_init_character_value; - } - else - { - gfc_free_expr (init_expr); - init_expr = NULL; - } - if (!init_expr && gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON - && sym->ts.u.cl->length && flag_max_stack_var_size != 0) - { - gfc_actual_arglist *arg; - init_expr = gfc_get_expr (); - init_expr->where = sym->declared_at; - init_expr->ts = sym->ts; - init_expr->expr_type = EXPR_FUNCTION; - init_expr->value.function.isym = - gfc_intrinsic_function_by_id (GFC_ISYM_REPEAT); - init_expr->value.function.name = "repeat"; - arg = gfc_get_actual_arglist (); - arg->expr = gfc_get_character_expr (sym->ts.kind, &sym->declared_at, - NULL, 1); - arg->expr->value.character.string[0] - = gfc_option.flag_init_character_value; - arg->next = gfc_get_actual_arglist (); - arg->next->expr = gfc_copy_expr (sym->ts.u.cl->length); - init_expr->value.function.actual = arg; - } - break; - - default: - gfc_free_expr (init_expr); - init_expr = NULL; - } - return init_expr; + /* Get the appropriate init expression. */ + return gfc_build_default_init_expr (&sym->ts, &sym->declared_at); } /* Add an initialization expression to a local variable. */ @@ -11312,10 +11648,11 @@ apply_default_init_local (gfc_symbol *sym) entry, so we just add a static initializer. Note that automatic variables are stack allocated even with -fno-automatic; we have also to exclude result variable, which are also nonstatic. */ - if (sym->attr.save || sym->ns->save_all - || (flag_max_stack_var_size == 0 && !sym->attr.result - && (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive) - && (!sym->attr.dimension || !is_non_constant_shape_array (sym)))) + if (!sym->attr.automatic + && (sym->attr.save || sym->ns->save_all + || (flag_max_stack_var_size == 0 && !sym->attr.result + && (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive) + && (!sym->attr.dimension || !is_non_constant_shape_array (sym))))) { /* Don't clobber an existing initializer! */ gcc_assert (sym->value == NULL); @@ -11460,7 +11797,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) a hidden default for allocatable components. */ if (!(sym->value || no_init_flag) && sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE - && !sym->ns->save_all && !sym->attr.save + && !(sym->ns->save_all && !sym->attr.automatic) && !sym->attr.save && !sym->attr.pointer && !sym->attr.allocatable && gfc_has_default_initializer (sym->ts.u.derived) && !gfc_notify_std (GFC_STD_F2008, "Implied SAVE for module variable " @@ -11471,10 +11808,29 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) /* Assign default initializer. */ if (!(sym->value || sym->attr.pointer || sym->attr.allocatable) && (!no_init_flag || sym->attr.intent == INTENT_OUT)) + sym->value = gfc_generate_initializer (&sym->ts, can_generate_init (sym)); + + return true; +} + + +/* F2008, C402 (R401): A colon shall not be used as a type-param-value + except in the declaration of an entity or component that has the POINTER + or ALLOCATABLE attribute. */ + +static bool +deferred_requirements (gfc_symbol *sym) +{ + if (sym->ts.deferred + && !(sym->attr.pointer + || sym->attr.allocatable + || sym->attr.omp_udr_artificial_var)) { - sym->value = gfc_default_initializer (&sym->ts); + gfc_error ("Entity %qs at %L has a deferred type parameter and " + "requires either the POINTER or ALLOCATABLE attribute", + sym->name, &sym->declared_at); + return false; } - return true; } @@ -11509,8 +11865,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) && !sym->attr.pointer && is_non_constant_shape_array (sym)) { - /* The shape of a main program or module array needs to be - constant. */ + /* F08:C541. The shape of an array defined in a main program or module + * needs to be constant. */ gfc_error ("The module or main program array %qs at %L must " "have constant shape", sym->name, &sym->declared_at); specification_expr = saved_specification_expr; @@ -11518,19 +11874,10 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) } /* Constraints on deferred type parameter. */ - if (sym->ts.deferred - && !(sym->attr.pointer - || sym->attr.allocatable - || sym->attr.omp_udr_artificial_var)) - { - gfc_error ("Entity %qs at %L has a deferred type parameter and " - "requires either the pointer or allocatable attribute", - sym->name, &sym->declared_at); - specification_expr = saved_specification_expr; - return false; - } + if (!deferred_requirements (sym)) + return false; - if (sym->ts.type == BT_CHARACTER) + if (sym->ts.type == BT_CHARACTER && !sym->attr.associate_var) { /* Make sure that character string variables with assumed length are dummy arguments. */ @@ -11956,10 +12303,15 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) module_name = strtok (name, "."); submodule_name = strtok (NULL, "."); - /* Stop the dummy characteristics test from using the interface - symbol instead of 'sym'. */ - iface = sym->ts.interface; - sym->ts.interface = NULL; + iface = sym->tlink; + sym->tlink = NULL; + + /* Make sure that the result uses the correct charlen for deferred + length results. */ + if (iface && sym->result + && iface->ts.type == BT_CHARACTER + && iface->ts.deferred) + sym->result->ts.u.cl = iface->ts.u.cl; if (iface == NULL) goto check_formal; @@ -11993,14 +12345,15 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) if (!gfc_check_result_characteristics (sym, iface, errmsg, 200)) { gfc_error ("%s between the MODULE PROCEDURE declaration " - "in module %s and the declaration at %L in " - "SUBMODULE %s", errmsg, module_name, - &sym->declared_at, submodule_name); + "in MODULE %qs and the declaration at %L in " + "(SUB)MODULE %qs", + errmsg, module_name, &sym->declared_at, + submodule_name ? submodule_name : module_name); return false; } check_formal: - /* Check the charcateristics of the formal arguments. */ + /* Check the characteristics of the formal arguments. */ if (sym->formal && sym->formal_ns) { for (arg = sym->formal; arg && arg->sym; arg = arg->next) @@ -12009,8 +12362,6 @@ check_formal: gfc_traverse_ns (sym->formal_ns, compare_fsyms); } } - - sym->ts.interface = iface; } return true; } @@ -12070,6 +12421,9 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) /* Skip this finalizer if we already resolved it. */ if (list->proc_tree) { + if (list->proc_tree->n.sym->formal->sym->as == NULL + || list->proc_tree->n.sym->formal->sym->as->rank == 0) + seen_scalar = true; prev_link = &(list->next); continue; } @@ -12164,7 +12518,7 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) } /* Is this the/a scalar finalizer procedure? */ - if (!arg->as || arg->as->rank == 0) + if (my_rank == 0) seen_scalar = true; /* Find the symtree for this procedure. */ @@ -12189,7 +12543,7 @@ error: /* Warn if we haven't seen a scalar finalizer procedure (but we know there were nodes in the list, must have been for arrays. It is surely a good idea to have a scalar version there if there's something to finalize. */ - if (warn_surprising && result && !seen_scalar) + if (warn_surprising && derived->f2k_derived->finalizers && !seen_scalar) gfc_warning (OPT_Wsurprising, "Only array FINAL procedures declared for derived type %qs" " defined at %L, suggest also scalar one", @@ -12475,7 +12829,17 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op, && p->access != ACCESS_PRIVATE && derived->ns == gfc_current_ns) { gfc_interface *head, *intr; - if (!gfc_check_new_interface (derived->ns->op[op], target_proc, p->where)) + + /* Preempt 'gfc_check_new_interface' for submodules, where the + mechanism for handling module procedures winds up resolving + operator interfaces twice and would otherwise cause an error. */ + for (intr = derived->ns->op[op]; intr; intr = intr->next) + if (intr->sym == target_proc + && target_proc->attr.used_in_submodule) + return true; + + if (!gfc_check_new_interface (derived->ns->op[op], + target_proc, p->where)) return false; head = derived->ns->op[op]; intr = gfc_get_interface (); @@ -13263,18 +13627,12 @@ resolve_component (gfc_component *c, gfc_symbol *sym) return false; } - /* C437. */ - if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE - && (!c->attr.class_ok - || !(CLASS_DATA (c)->attr.class_pointer - || CLASS_DATA (c)->attr.allocatable))) - { - gfc_error ("Component %qs with CLASS at %L must be allocatable " - "or pointer", c->name, &c->loc); - /* Prevent a recurrence of the error. */ - c->ts.type = BT_UNKNOWN; - return false; - } + /* If an allocatable component derived type is of the same type as + the enclosing derived type, we need a vtable generating so that + the __deallocate procedure is created. */ + if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + && c->ts.u.derived == sym && c->attr.allocatable == 1) + gfc_find_vtab (&c->ts); /* Ensure that all the derived type components are put on the derived type list; even in formal namespaces, where derived type @@ -13491,11 +13849,31 @@ resolve_fl_derived (gfc_symbol *sym) } +/* Check for formatted read and write DTIO procedures. */ + +static bool +dtio_procs_present (gfc_symbol *sym) +{ + gfc_symbol *derived; + + if (sym->ts.type == BT_CLASS) + derived = CLASS_DATA (sym)->ts.u.derived; + else if (sym->ts.type == BT_DERIVED) + derived = sym->ts.u.derived; + else + return false; + + return gfc_find_specific_dtio_proc (derived, true, true) != NULL + && gfc_find_specific_dtio_proc (derived, false, true) != NULL; +} + + static bool resolve_fl_namelist (gfc_symbol *sym) { gfc_namelist *nl; gfc_symbol *nlsym; + bool dtio; for (nl = sym->namelist; nl; nl = nl->next) { @@ -13529,9 +13907,9 @@ resolve_fl_namelist (gfc_symbol *sym) sym->name, &sym->declared_at)) return false; - /* FIXME: Once UDDTIO is implemented, the following can be - removed. */ - if (nl->sym->ts.type == BT_CLASS) + dtio = dtio_procs_present (nl->sym); + + if (nl->sym->ts.type == BT_CLASS && !dtio) { gfc_error ("NAMELIST object %qs in namelist %qs at %L is " "polymorphic and requires a defined input/output " @@ -13548,14 +13926,7 @@ resolve_fl_namelist (gfc_symbol *sym) "or POINTER components", nl->sym->name, sym->name, &sym->declared_at)) return false; - - /* FIXME: Once UDDTIO is implemented, the following can be - removed. */ - gfc_error ("NAMELIST object %qs in namelist %qs at %L has " - "ALLOCATABLE or POINTER components and thus requires " - "a defined input/output procedure", nl->sym->name, - sym->name, &sym->declared_at); - return false; + return true; } } @@ -13574,6 +13945,11 @@ resolve_fl_namelist (gfc_symbol *sym) return false; } + /* If the derived type has specific DTIO procedures for both read and + write then namelist objects with private components are OK. */ + if (dtio_procs_present (nl->sym)) + continue; + /* Types with private components that came here by USE-association. */ if (nl->sym->ts.type == BT_DERIVED && derived_inaccessible (nl->sym->ts.u.derived)) @@ -13640,6 +14016,10 @@ resolve_fl_parameter (gfc_symbol *sym) return false; } + /* Constraints on deferred type parameter. */ + if (!deferred_requirements (sym)) + return false; + /* Make sure a parameter that has been implicitly typed still matches the implicit type, since PARAMETER statements can precede IMPLICIT statements. */ @@ -13662,6 +14042,15 @@ resolve_fl_parameter (gfc_symbol *sym) &sym->value->where); return false; } + + /* F03:C509,C514. */ + if (sym->ts.type == BT_CLASS) + { + gfc_error ("CLASS variable %qs at %L cannot have the PARAMETER attribute", + sym->name, &sym->declared_at); + return false; + } + return true; } @@ -13691,6 +14080,19 @@ resolve_symbol (gfc_symbol *sym) (just like derived type declaration symbols have flavor FL_DERIVED). */ gcc_assert (sym->ts.type != BT_UNION); + /* Coarrayed polymorphic objects with allocatable or pointer components are + yet unsupported for -fcoarray=lib. */ + if (flag_coarray == GFC_FCOARRAY_LIB && sym->ts.type == BT_CLASS + && sym->ts.u.derived && CLASS_DATA (sym) + && CLASS_DATA (sym)->attr.codimension + && (CLASS_DATA (sym)->ts.u.derived->attr.alloc_comp + || CLASS_DATA (sym)->ts.u.derived->attr.pointer_comp)) + { + gfc_error ("Sorry, allocatable/pointer components in polymorphic (CLASS) " + "type coarrays at %L are unsupported", &sym->declared_at); + return; + } + if (sym->attr.artificial) return; @@ -13802,7 +14204,10 @@ resolve_symbol (gfc_symbol *sym) /* The specific case of an external procedure should emit an error in the case that there is no implicit type. */ if (!mp_flag) - gfc_set_default_type (sym, sym->attr.external, NULL); + { + if (!sym->attr.mixed_entry_master) + gfc_set_default_type (sym, sym->attr.external, NULL); + } else { /* Result may be in another namespace. */ @@ -14236,7 +14641,7 @@ resolve_symbol (gfc_symbol *sym) if (class_attr.codimension && !(class_attr.allocatable || sym->attr.dummy || sym->attr.save || sym->attr.select_type_temporary - || sym->ns->save_all + || (sym->ns->save_all && !sym->attr.automatic) || sym->ns->proc_name->attr.flavor == FL_MODULE || sym->ns->proc_name->attr.is_main_program || sym->attr.function || sym->attr.result || sym->attr.use_assoc)) @@ -14324,7 +14729,7 @@ resolve_symbol (gfc_symbol *sym) for (; formal; formal = formal->next) if (formal->sym && formal->sym->attr.flavor == FL_NAMELIST) { - gfc_error ("Namelist '%s' can not be an argument to " + gfc_error ("Namelist %qs can not be an argument to " "subroutine or function at %L", formal->sym->name, &sym->declared_at); return; @@ -14358,14 +14763,14 @@ resolve_symbol (gfc_symbol *sym) an error for host associated variables in the specification expression for an array_valued function. */ if (sym->attr.function && sym->as) - formal_arg_flag = 1; + formal_arg_flag = true; saved_specification_expr = specification_expr; specification_expr = true; gfc_resolve_array_spec (sym->as, check_constant); specification_expr = saved_specification_expr; - formal_arg_flag = 0; + formal_arg_flag = false; /* Resolve formal namespaces. */ if (sym->formal_ns && sym->formal_ns != gfc_current_ns @@ -14388,7 +14793,8 @@ resolve_symbol (gfc_symbol *sym) } /* Check threadprivate restrictions. */ - if (sym->attr.threadprivate && !sym->attr.save && !sym->ns->save_all + if (sym->attr.threadprivate && !sym->attr.save + && !(sym->ns->save_all && !sym->attr.automatic) && (!sym->attr.in_common && sym->module == NULL && (sym->ns->proc_name == NULL @@ -14399,7 +14805,7 @@ resolve_symbol (gfc_symbol *sym) if (sym->attr.omp_declare_target && sym->attr.flavor == FL_VARIABLE && !sym->attr.save - && !sym->ns->save_all + && !(sym->ns->save_all && !sym->attr.automatic) && (!sym->attr.in_common && sym->module == NULL && (sym->ns->proc_name == NULL @@ -14495,6 +14901,10 @@ check_data_variable (gfc_data_variable *var, locus *where) mpz_init_set_si (offset, 0); e = var->expr; + if (e->expr_type == EXPR_FUNCTION && e->value.function.isym + && e->value.function.isym->id == GFC_ISYM_CAF_GET) + e = e->value.function.actual->expr; + if (e->expr_type != EXPR_VARIABLE) gfc_internal_error ("check_data_variable(): Bad expression"); @@ -14995,12 +15405,13 @@ warn_unused_fortran_label (gfc_st_label *label) switch (label->referenced) { case ST_LABEL_UNKNOWN: - gfc_warning (0, "Label %d at %L defined but not used", label->value, - &label->where); + gfc_warning (OPT_Wunused_label, "Label %d at %L defined but not used", + label->value, &label->where); break; case ST_LABEL_BAD_TARGET: - gfc_warning (0, "Label %d at %L defined but cannot be used", + gfc_warning (OPT_Wunused_label, + "Label %d at %L defined but cannot be used", label->value, &label->where); break; @@ -15362,6 +15773,54 @@ resolve_equivalence (gfc_equiv *eq) } +/* Function called by resolve_fntype to flag other symbol used in the + length type parameter specification of function resuls. */ + +static bool +flag_fn_result_spec (gfc_expr *expr, + gfc_symbol *sym ATTRIBUTE_UNUSED, + int *f ATTRIBUTE_UNUSED) +{ + gfc_namespace *ns; + gfc_symbol *s; + + if (expr->expr_type == EXPR_VARIABLE) + { + s = expr->symtree->n.sym; + for (ns = s->ns; ns; ns = ns->parent) + if (!ns->parent) + break; + + if (!s->fn_result_spec + && s->attr.flavor == FL_PARAMETER) + { + /* Function contained in a module.... */ + if (ns->proc_name && ns->proc_name->attr.flavor == FL_MODULE) + { + gfc_symtree *st; + s->fn_result_spec = 1; + /* Make sure that this symbol is translated as a module + variable. */ + st = gfc_get_unique_symtree (ns); + st->n.sym = s; + s->refs++; + } + /* ... which is use associated and called. */ + else if (s->attr.use_assoc || s->attr.used_in_submodule + || + /* External function matched with an interface. */ + (s->ns->proc_name + && ((s->ns == ns + && s->ns->proc_name->attr.if_source == IFSRC_DECL) + || s->ns->proc_name->attr.if_source == IFSRC_IFBODY) + && s->ns->proc_name->attr.function)) + s->fn_result_spec = 1; + } + } + return false; +} + + /* Resolve function and ENTRY types, issue diagnostics if needed. */ static void @@ -15412,6 +15871,9 @@ resolve_fntype (gfc_namespace *ns) el->sym->attr.untyped = 1; } } + + if (sym->ts.type == BT_CHARACTER) + gfc_traverse_expr (sym->ts.u.cl->length, NULL, flag_fn_result_spec, 0); } @@ -15593,6 +16055,8 @@ resolve_types (gfc_namespace *ns) gfc_resolve_uops (ns->uop_root); + gfc_traverse_ns (ns, gfc_verify_DTIO_procedures); + gfc_resolve_omp_declare_simd (ns); gfc_resolve_omp_udrs (ns->omp_udr_root); @@ -15660,7 +16124,8 @@ gfc_resolve (gfc_namespace *ns) /* As gfc_resolve can be called during resolution of an OpenMP construct body, we should clear any state associated to it, so that say NS's DO loops are not interpreted as OpenMP loops. */ - gfc_omp_save_and_clear_state (&old_omp_state); + if (!ns->construct_entities) + gfc_omp_save_and_clear_state (&old_omp_state); resolve_types (ns); component_assignment_level = 0; @@ -15672,5 +16137,6 @@ gfc_resolve (gfc_namespace *ns) gfc_run_passes (ns); - gfc_omp_restore_state (&old_omp_state); + if (!ns->construct_entities) + gfc_omp_restore_state (&old_omp_state); } diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 6a7a5b68bb..82f431da52 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -1,5 +1,5 @@ /* Character scanner. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -1406,15 +1406,16 @@ restart: if (i == 4) old_loc = gfc_current_locus; } - gfc_error (is_openmp ? "Wrong OpenACC continuation at %C: " - "expected !$ACC, got !$OMP" - : "Wrong OpenMP continuation at %C: " - "expected !$OMP, got !$ACC"); + gfc_error (is_openmp + ? G_("Wrong OpenACC continuation at %C: " + "expected !$ACC, got !$OMP") + : G_("Wrong OpenMP continuation at %C: " + "expected !$OMP, got !$ACC")); } if (c != '&') { - if (in_string) + if (in_string && gfc_current_locus.nextc) { gfc_current_locus.nextc--; if (warn_ampersand && in_string == INSTRING_WARN) @@ -1427,7 +1428,10 @@ restart: /* Both !$omp and !$ -fopenmp continuation lines have & on the continuation line only optionally. */ else if (openmp_flag || openacc_flag || openmp_cond_flag) - gfc_current_locus.nextc--; + { + if (gfc_current_locus.nextc) + gfc_current_locus.nextc--; + } else { c = ' '; @@ -1499,10 +1503,11 @@ restart: if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i]) is_openmp = 1; } - gfc_error (is_openmp ? "Wrong OpenACC continuation at %C: " - "expected !$ACC, got !$OMP" - : "Wrong OpenMP continuation at %C: " - "expected !$OMP, got !$ACC"); + gfc_error (is_openmp + ? G_("Wrong OpenACC continuation at %C: " + "expected !$ACC, got !$OMP") + : G_("Wrong OpenMP continuation at %C: " + "expected !$OMP, got !$ACC")); } else if (!openmp_flag && !openacc_flag) for (i = 0; i < 5; i++) diff --git a/gcc/fortran/scanner.h b/gcc/fortran/scanner.h index 4be38f5769..86fd2850d0 100644 --- a/gcc/fortran/scanner.h +++ b/gcc/fortran/scanner.h @@ -1,5 +1,5 @@ /* Character scanner header. - Copyright (C) 2013-2016 Free Software Foundation, Inc. + Copyright (C) 2013-2017 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.c index fcf49b7626..169aef1d89 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -1,5 +1,5 @@ /* Simplify intrinsic functions at compile-time. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -127,7 +127,7 @@ get_kind (bt type, gfc_expr *k, const char *name, int default_kind) return -1; } - if (gfc_extract_int (k, &kind) != NULL + if (gfc_extract_int (k, &kind) || gfc_validate_kind (type, kind, true) < 0) { gfc_error ("Invalid KIND parameter of %s at %L", name, &k->where); @@ -489,6 +489,8 @@ simplify_transformation_to_scalar (gfc_expr *result, gfc_expr *array, gfc_expr * } result = op (result, gfc_copy_expr (a)); + if (!result) + return result; } return result; @@ -608,9 +610,17 @@ simplify_transformation_to_array (gfc_expr *result, gfc_expr *array, gfc_expr *d n++; if (n < result->rank) { - count [n]++; + /* If the nested loop is unrolled GFC_MAX_DIMENSIONS + times, we'd warn for the last iteration, because the + array index will have already been incremented to the + array sizes, and we can't tell that this must make + the test against result->rank false, because ranks + must not exceed GFC_MAX_DIMENSIONS. */ + GCC_DIAGNOSTIC_PUSH_IGNORED (-Warray-bounds) + count[n]++; base += sstride[n]; dest += dstride[n]; + GCC_DIAGNOSTIC_POP } else done = true; @@ -1489,7 +1499,7 @@ gfc_simplify_btest (gfc_expr *e, gfc_expr *bit) if (e->expr_type != EXPR_CONSTANT || bit->expr_type != EXPR_CONSTANT) return NULL; - if (gfc_extract_int (bit, &b) != NULL || b < 0) + if (gfc_extract_int (bit, &b) || b < 0) return gfc_get_logical_expr (gfc_default_logical_kind, &e->where, false); return gfc_get_logical_expr (gfc_default_logical_kind, &e->where, @@ -1704,6 +1714,150 @@ gfc_simplify_conjg (gfc_expr *e) return range_check (result, "CONJG"); } +/* Return the simplification of the constant expression in icall, or NULL + if the expression is not constant. */ + +static gfc_expr * +simplify_trig_call (gfc_expr *icall) +{ + gfc_isym_id func = icall->value.function.isym->id; + gfc_expr *x = icall->value.function.actual->expr; + + /* The actual simplifiers will return NULL for non-constant x. */ + switch (func) + { + case GFC_ISYM_ACOS: + return gfc_simplify_acos (x); + case GFC_ISYM_ASIN: + return gfc_simplify_asin (x); + case GFC_ISYM_ATAN: + return gfc_simplify_atan (x); + case GFC_ISYM_COS: + return gfc_simplify_cos (x); + case GFC_ISYM_COTAN: + return gfc_simplify_cotan (x); + case GFC_ISYM_SIN: + return gfc_simplify_sin (x); + case GFC_ISYM_TAN: + return gfc_simplify_tan (x); + default: + gfc_internal_error ("in simplify_trig_call(): Bad intrinsic"); + } +} + +/* Convert a floating-point number from radians to degrees. */ + +static void +degrees_f (mpfr_t x, mp_rnd_t rnd_mode) +{ + mpfr_t tmp; + mpfr_init (tmp); + + /* Set x = x % 2pi to avoid offsets with large angles. */ + mpfr_const_pi (tmp, rnd_mode); + mpfr_mul_ui (tmp, tmp, 2, rnd_mode); + mpfr_fmod (tmp, x, tmp, rnd_mode); + + /* Set x = x * 180. */ + mpfr_mul_ui (x, x, 180, rnd_mode); + + /* Set x = x / pi. */ + mpfr_const_pi (tmp, rnd_mode); + mpfr_div (x, x, tmp, rnd_mode); + + mpfr_clear (tmp); +} + +/* Convert a floating-point number from degrees to radians. */ + +static void +radians_f (mpfr_t x, mp_rnd_t rnd_mode) +{ + mpfr_t tmp; + mpfr_init (tmp); + + /* Set x = x % 360 to avoid offsets with large angles. */ + mpfr_set_ui (tmp, 360, rnd_mode); + mpfr_fmod (tmp, x, tmp, rnd_mode); + + /* Set x = x * pi. */ + mpfr_const_pi (tmp, rnd_mode); + mpfr_mul (x, x, tmp, rnd_mode); + + /* Set x = x / 180. */ + mpfr_div_ui (x, x, 180, rnd_mode); + + mpfr_clear (tmp); +} + + +/* Convert argument to radians before calling a trig function. */ + +gfc_expr * +gfc_simplify_trigd (gfc_expr *icall) +{ + gfc_expr *arg; + + arg = icall->value.function.actual->expr; + + if (arg->ts.type != BT_REAL) + gfc_internal_error ("in gfc_simplify_trigd(): Bad type"); + + if (arg->expr_type == EXPR_CONSTANT) + /* Convert constant to radians before passing off to simplifier. */ + radians_f (arg->value.real, GFC_RND_MODE); + + /* Let the usual simplifier take over - we just simplified the arg. */ + return simplify_trig_call (icall); +} + +/* Convert result of an inverse trig function to degrees. */ + +gfc_expr * +gfc_simplify_atrigd (gfc_expr *icall) +{ + gfc_expr *result; + + if (icall->value.function.actual->expr->ts.type != BT_REAL) + gfc_internal_error ("in gfc_simplify_atrigd(): Bad type"); + + /* See if another simplifier has work to do first. */ + result = simplify_trig_call (icall); + + if (result && result->expr_type == EXPR_CONSTANT) + { + /* Convert constant to degrees after passing off to actual simplifier. */ + degrees_f (result->value.real, GFC_RND_MODE); + return result; + } + + /* Let gfc_resolve_atrigd take care of the non-constant case. */ + return NULL; +} + +/* Convert the result of atan2 to degrees. */ + +gfc_expr * +gfc_simplify_atan2d (gfc_expr *y, gfc_expr *x) +{ + gfc_expr *result; + + if (x->ts.type != BT_REAL || y->ts.type != BT_REAL) + gfc_internal_error ("in gfc_simplify_atan2d(): Bad type"); + + if (x->expr_type == EXPR_CONSTANT && y->expr_type == EXPR_CONSTANT) + { + result = gfc_simplify_atan2 (y, x); + if (result != NULL) + { + degrees_f (result->value.real, GFC_RND_MODE); + return result; + } + } + + /* Let gfc_resolve_atan2d take care of the non-constant case. */ + return NULL; +} gfc_expr * gfc_simplify_cos (gfc_expr *x) @@ -1840,7 +1994,7 @@ gfc_simplify_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) shft = shft < 0 ? 1 - shft : shft; /* Special case: Shift to the original order! */ - if (shft % sz == 0) + if (sz == 0 || shft % sz == 0) return a; result = gfc_copy_expr (a); @@ -2312,6 +2466,37 @@ gfc_simplify_exponent (gfc_expr *x) gfc_expr * +gfc_simplify_failed_or_stopped_images (gfc_expr *team ATTRIBUTE_UNUSED, + gfc_expr *kind) +{ + if (flag_coarray == GFC_FCOARRAY_NONE) + { + gfc_current_locus = *gfc_current_intrinsic_where; + gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable"); + return &gfc_bad_expr; + } + + if (flag_coarray == GFC_FCOARRAY_SINGLE) + { + gfc_expr *result; + int actual_kind; + if (kind) + gfc_extract_int (kind, &actual_kind); + else + actual_kind = gfc_default_integer_kind; + + result = gfc_get_array_expr (BT_INTEGER, actual_kind, &gfc_current_locus); + result->rank = 1; + return result; + } + + /* For fcoarray = lib no simplification is possible, because it is not known + what images failed or are stopped at compile time. */ + return NULL; +} + + +gfc_expr * gfc_simplify_float (gfc_expr *a) { gfc_expr *result; @@ -2371,7 +2556,7 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr *mold) if (UNLIMITED_POLY (a) || UNLIMITED_POLY (mold)) return NULL; - /* Return .false. if the dynamic type can never be the same. */ + /* Return .false. if the dynamic type can never be an extension. */ if ((a->ts.type == BT_CLASS && mold->ts.type == BT_CLASS && !gfc_type_is_extension_of (mold->ts.u.derived->components->ts.u.derived, @@ -2381,18 +2566,19 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr *mold) mold->ts.u.derived->components->ts.u.derived)) || (a->ts.type == BT_DERIVED && mold->ts.type == BT_CLASS && !gfc_type_is_extension_of - (a->ts.u.derived, - mold->ts.u.derived->components->ts.u.derived) - && !gfc_type_is_extension_of (mold->ts.u.derived->components->ts.u.derived, a->ts.u.derived)) || (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED && !gfc_type_is_extension_of (mold->ts.u.derived, - a->ts.u.derived->components->ts.u.derived))) + a->ts.u.derived->components->ts.u.derived) + && !gfc_type_is_extension_of + (a->ts.u.derived->components->ts.u.derived, + mold->ts.u.derived))) return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, false); - if (mold->ts.type == BT_DERIVED + /* Return .true. if the dynamic type is guaranteed to be an extension. */ + if (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED && gfc_type_is_extension_of (mold->ts.u.derived, a->ts.u.derived->components->ts.u.derived)) return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, true); @@ -3280,7 +3466,6 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz) return NULL; gfc_extract_int (sz, &ssize); - } else ssize = isize; @@ -3294,7 +3479,10 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz) { if (sz == NULL) gfc_error ("Magnitude of second argument of ISHFTC exceeds " - "BIT_SIZE of first argument at %L", &s->where); + "BIT_SIZE of first argument at %C"); + else + gfc_error ("Absolute value of SHIFT shall be less than or equal " + "to SIZE at %C"); return &gfc_bad_expr; } @@ -4077,7 +4265,6 @@ gfc_simplify_maskr (gfc_expr *i, gfc_expr *kind_arg) { gfc_expr *result; int kind, arg, k; - const char *s; if (i->expr_type != EXPR_CONSTANT) return NULL; @@ -4087,8 +4274,8 @@ gfc_simplify_maskr (gfc_expr *i, gfc_expr *kind_arg) return &gfc_bad_expr; k = gfc_validate_kind (BT_INTEGER, kind, false); - s = gfc_extract_int (i, &arg); - gcc_assert (!s); + bool fail = gfc_extract_int (i, &arg); + gcc_assert (!fail); result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where); @@ -4108,7 +4295,6 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg) { gfc_expr *result; int kind, arg, k; - const char *s; mpz_t z; if (i->expr_type != EXPR_CONSTANT) @@ -4119,8 +4305,8 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg) return &gfc_bad_expr; k = gfc_validate_kind (BT_INTEGER, kind, false); - s = gfc_extract_int (i, &arg); - gcc_assert (!s); + bool fail = gfc_extract_int (i, &arg); + gcc_assert (!fail); result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where); @@ -4903,7 +5089,6 @@ gfc_expr * gfc_simplify_poppar (gfc_expr *e) { gfc_expr *popcnt; - const char *s; int i; if (e->expr_type != EXPR_CONSTANT) @@ -4912,8 +5097,8 @@ gfc_simplify_poppar (gfc_expr *e) popcnt = gfc_simplify_popcnt (e); gcc_assert (popcnt); - s = gfc_extract_int (popcnt, &i); - gcc_assert (!s); + bool fail = gfc_extract_int (popcnt, &i); + gcc_assert (!fail); return gfc_get_int_expr (gfc_default_integer_kind, &e->where, i % 2); } @@ -5123,10 +5308,10 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n) if (len || (e->ts.u.cl->length && - mpz_sgn (e->ts.u.cl->length->value.integer)) != 0) + mpz_sgn (e->ts.u.cl->length->value.integer) != 0)) { - const char *res = gfc_extract_int (n, &ncop); - gcc_assert (res == NULL); + bool fail = gfc_extract_int (n, &ncop); + gcc_assert (!fail); } else ncop = 0; @@ -5536,7 +5721,7 @@ gfc_simplify_selected_int_kind (gfc_expr *e) { int i, kind, range; - if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &range) != NULL) + if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &range)) return NULL; kind = INT_MAX; @@ -5565,7 +5750,7 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx) else { if (p->expr_type != EXPR_CONSTANT - || gfc_extract_int (p, &precision) != NULL) + || gfc_extract_int (p, &precision)) return NULL; loc = &p->where; } @@ -5575,7 +5760,7 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx) else { if (q->expr_type != EXPR_CONSTANT - || gfc_extract_int (q, &range) != NULL) + || gfc_extract_int (q, &range)) return NULL; if (!loc) @@ -5587,7 +5772,7 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx) else { if (rdx->expr_type != EXPR_CONSTANT - || gfc_extract_int (rdx, &radix) != NULL) + || gfc_extract_int (rdx, &radix)) return NULL; if (!loc) @@ -6185,8 +6370,7 @@ gfc_simplify_spread (gfc_expr *source, gfc_expr *dim_expr, gfc_expr *ncopies_exp } else { - gfc_error ("Simplification of SPREAD at %L not yet implemented", - &source->where); + gfc_error ("Simplification of SPREAD at %C not yet implemented"); return &gfc_bad_expr; } @@ -6241,6 +6425,41 @@ gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_expr *mask) gfc_expr * +gfc_simplify_cotan (gfc_expr *x) +{ + gfc_expr *result; + mpc_t swp, *val; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + + switch (x->ts.type) + { + case BT_REAL: + mpfr_cot (result->value.real, x->value.real, GFC_RND_MODE); + break; + + case BT_COMPLEX: + /* There is no builtin mpc_cot, so compute cot = cos / sin. */ + val = &result->value.complex; + mpc_init2 (swp, mpfr_get_default_prec ()); + mpc_cos (swp, x->value.complex, GFC_MPC_RND_MODE); + mpc_sin (*val, x->value.complex, GFC_MPC_RND_MODE); + mpc_div (*val, swp, *val, GFC_MPC_RND_MODE); + mpc_clear (swp); + break; + + default: + gcc_unreachable (); + } + + return range_check (result, "COTAN"); +} + + +gfc_expr * gfc_simplify_tan (gfc_expr *x) { gfc_expr *result; @@ -6575,6 +6794,36 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub) return result; } +gfc_expr * +gfc_simplify_image_status (gfc_expr *image, gfc_expr *team ATTRIBUTE_UNUSED) +{ + if (flag_coarray == GFC_FCOARRAY_NONE) + { + gfc_current_locus = *gfc_current_intrinsic_where; + gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable"); + return &gfc_bad_expr; + } + + /* Simplification is possible for fcoarray = single only. For all other modes + the result depends on runtime conditions. */ + if (flag_coarray != GFC_FCOARRAY_SINGLE) + return NULL; + + if (gfc_is_constant_expr (image)) + { + gfc_expr *result; + result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind, + &image->where); + if (mpz_get_si (image->value.integer) == 1) + mpz_set_si (result->value.integer, 0); + else + mpz_set_si (result->value.integer, GFC_STAT_STOPPED_IMAGE); + return result; + } + else + return NULL; +} + gfc_expr * gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim, @@ -6969,6 +7218,7 @@ gfc_convert_char_constant (gfc_expr *e, bt type ATTRIBUTE_UNUSED, int kind) "into character kind %d", gfc_print_wide_char (result->value.character.string[i]), &e->where, kind); + gfc_free_expr (result); return &gfc_bad_expr; } @@ -7043,9 +7293,17 @@ gfc_simplify_compiler_version (void) gfc_expr * simplify_ieee_selected_real_kind (gfc_expr *expr) { - gfc_actual_arglist *arg = expr->value.function.actual; - gfc_expr *p = arg->expr, *q = arg->next->expr, - *rdx = arg->next->next->expr; + gfc_actual_arglist *arg; + gfc_expr *p = NULL, *q = NULL, *rdx = NULL; + + arg = expr->value.function.actual; + p = arg->expr; + if (arg->next) + { + q = arg->next->expr; + if (arg->next->next) + rdx = arg->next->next->expr; + } /* Currently, if IEEE is supported and this module is built, it means all our floating-point types conform to IEEE. Hence, we simply handle diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 7395497dcb..bffe50df7b 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -1,5 +1,5 @@ /* Build executable statement trees. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -120,6 +120,7 @@ gfc_free_statement (gfc_code *p) case EXEC_UNLOCK: case EXEC_EVENT_POST: case EXEC_EVENT_WAIT: + case EXEC_FAIL_IMAGE: break; case EXEC_BLOCK: @@ -207,6 +208,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OACC_ROUTINE: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: + case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -214,15 +216,23 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_END_SINGLE: + case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -230,17 +240,18 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TEAMS: case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: - case EXEC_OMP_PARALLEL_WORKSHARE: gfc_free_omp_clauses (p->ext.omp_clauses); break; - case EXEC_OMP_CRITICAL: + case EXEC_OMP_END_CRITICAL: free (CONST_CAST (char *, p->ext.omp_name)); break; @@ -252,7 +263,6 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_MASTER: - case EXEC_OMP_ORDERED: case EXEC_OMP_END_NOWAIT: case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 0ee7decffd..ec43e635bf 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -1,5 +1,5 @@ /* Maintain binary trees of symbols. - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -87,6 +87,15 @@ const mstring save_status[] = minit ("IMPLICIT-SAVE", SAVE_IMPLICIT), }; +/* Set the mstrings for DTIO procedure names. */ +const mstring dtio_procs[] = +{ + minit ("_dtio_formatted_read", DTIO_RF), + minit ("_dtio_formatted_write", DTIO_WF), + minit ("_dtio_unformatted_read", DTIO_RUF), + minit ("_dtio_unformatted_write", DTIO_WUF), +}; + /* This is to make sure the backend generates setup code in the correct order. */ @@ -373,9 +382,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) *is_bind_c = "BIND(C)", *procedure = "PROCEDURE", *proc_pointer = "PROCEDURE POINTER", *abstract = "ABSTRACT", *asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION", - *contiguous = "CONTIGUOUS", *generic = "GENERIC"; + *contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC"; static const char *threadprivate = "THREADPRIVATE"; static const char *omp_declare_target = "OMP DECLARE TARGET"; + static const char *omp_declare_target_link = "OMP DECLARE TARGET LINK"; static const char *oacc_declare_copyin = "OACC DECLARE COPYIN"; static const char *oacc_declare_create = "OACC DECLARE CREATE"; static const char *oacc_declare_deviceptr = "OACC DECLARE DEVICEPTR"; @@ -438,6 +448,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (dummy, save); conf (in_common, save); conf (result, save); + conf (automatic, save); switch (attr->flavor) { @@ -454,7 +465,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) gfc_error ("Namelist group name at %L cannot have the " "SAVE attribute", where); return false; - break; case FL_PROCEDURE: /* Conflicts between SAVE and PROCEDURE will be checked at resolution stage, see "resolve_fl_procedure". */ @@ -464,8 +474,13 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) } } - if (attr->dummy && ((attr->function || attr->subroutine) && - gfc_current_state () == COMP_CONTAINS)) + /* The copying of procedure dummy arguments for module procedures in + a submodule occur whilst the current state is COMP_CONTAINS. It + is necessary, therefore, to let this through. */ + if (attr->dummy + && (attr->function || attr->subroutine) + && gfc_current_state () == COMP_CONTAINS + && !(gfc_new_block && gfc_new_block->abr_modproc_decl)) gfc_error_now ("internal procedure %qs at %L conflicts with " "DUMMY argument", name, where); @@ -473,12 +488,19 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (dummy, intrinsic); conf (dummy, threadprivate); conf (dummy, omp_declare_target); + conf (dummy, omp_declare_target_link); conf (pointer, target); conf (pointer, intrinsic); conf (pointer, elemental); conf (pointer, codimension); conf (allocatable, elemental); + conf (in_common, automatic); + conf (in_equivalence, automatic); + conf (result, automatic); + conf (use_assoc, automatic); + conf (dummy, automatic); + conf (target, external); conf (target, intrinsic); @@ -517,14 +539,18 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (in_equivalence, allocatable); conf (in_equivalence, threadprivate); conf (in_equivalence, omp_declare_target); + conf (in_equivalence, omp_declare_target_link); conf (in_equivalence, oacc_declare_create); conf (in_equivalence, oacc_declare_copyin); conf (in_equivalence, oacc_declare_deviceptr); conf (in_equivalence, oacc_declare_device_resident); + conf (in_equivalence, is_bind_c); conf (dummy, result); conf (entry, result); conf (generic, result); + conf (generic, omp_declare_target); + conf (generic, omp_declare_target_link); conf (function, subroutine); @@ -570,6 +596,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (cray_pointee, in_equivalence); conf (cray_pointee, threadprivate); conf (cray_pointee, omp_declare_target); + conf (cray_pointee, omp_declare_target_link); conf (cray_pointee, oacc_declare_create); conf (cray_pointee, oacc_declare_copyin); conf (cray_pointee, oacc_declare_deviceptr); @@ -626,8 +653,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (procedure, entry) conf (proc_pointer, abstract) + conf (proc_pointer, omp_declare_target) + conf (proc_pointer, omp_declare_target_link) conf (entry, omp_declare_target) + conf (entry, omp_declare_target_link) conf (entry, oacc_declare_create) conf (entry, oacc_declare_copyin) conf (entry, oacc_declare_deviceptr) @@ -669,6 +699,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (subroutine); conf2 (threadprivate); conf2 (omp_declare_target); + conf2 (omp_declare_target_link); conf2 (oacc_declare_create); conf2 (oacc_declare_copyin); conf2 (oacc_declare_deviceptr); @@ -719,6 +750,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) if (!attr->proc_pointer) conf2 (in_common); + conf2 (omp_declare_target_link); + switch (attr->proc) { case PROC_ST_FUNCTION: @@ -755,6 +788,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (threadprivate); conf2 (result); conf2 (omp_declare_target); + conf2 (omp_declare_target_link); conf2 (oacc_declare_create); conf2 (oacc_declare_copyin); conf2 (oacc_declare_deviceptr); @@ -933,6 +967,21 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where) bool +gfc_add_automatic (symbol_attribute *attr, const char *name, locus *where) +{ + if (check_used (attr, name, where)) + return false; + + if (attr->automatic && !gfc_notify_std (GFC_STD_LEGACY, + "Duplicate AUTOMATIC attribute specified at %L", where)) + return false; + + attr->automatic = 1; + return check_conflict (attr, name, where); +} + + +bool gfc_add_codimension (symbol_attribute *attr, const char *name, locus *where) { @@ -1270,6 +1319,22 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name, bool +gfc_add_omp_declare_target_link (symbol_attribute *attr, const char *name, + locus *where) +{ + + if (check_used (attr, name, where)) + return false; + + if (attr->omp_declare_target_link) + return true; + + attr->omp_declare_target_link = 1; + return check_conflict (attr, name, where); +} + + +bool gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name, locus *where) { @@ -1587,6 +1652,13 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name, if (attr->flavor == f && f == FL_VARIABLE) return true; + /* Copying a procedure dummy argument for a module procedure in a + submodule results in the flavor being copied and would result in + an error without this. */ + if (gfc_new_block && gfc_new_block->abr_modproc_decl + && attr->flavor == f && f == FL_PROCEDURE) + return true; + if (attr->flavor != FL_UNKNOWN) { if (where == NULL) @@ -1880,6 +1952,8 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) if (src->allocatable && !gfc_add_allocatable (dest, where)) goto fail; + if (src->automatic && !gfc_add_automatic (dest, NULL, where)) + goto fail; if (src->dimension && !gfc_add_dimension (dest, NULL, where)) goto fail; if (src->codimension && !gfc_add_codimension (dest, NULL, where)) @@ -1906,6 +1980,9 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) if (src->omp_declare_target && !gfc_add_omp_declare_target (dest, NULL, where)) goto fail; + if (src->omp_declare_target_link + && !gfc_add_omp_declare_target_link (dest, NULL, where)) + goto fail; if (src->oacc_declare_create && !gfc_add_oacc_declare_create (dest, NULL, where)) goto fail; @@ -2085,7 +2162,7 @@ gfc_add_component (gfc_symbol *sym, const char *name, else tail->next = p; - p->name = gfc_get_string (name); + p->name = gfc_get_string ("%s", name); p->loc = gfc_current_locus; p->ts.type = BT_UNKNOWN; @@ -2692,7 +2769,7 @@ gfc_new_symtree (gfc_symtree **root, const char *name) gfc_symtree *st; st = XCNEW (gfc_symtree); - st->name = gfc_get_string (name); + st->name = gfc_get_string ("%s", name); gfc_insert_bbt (root, st, compare_symtree); return st; @@ -2705,10 +2782,20 @@ void gfc_delete_symtree (gfc_symtree **root, const char *name) { gfc_symtree st, *st0; + const char *p; + + /* Submodules are marked as mod.submod. When freeing a submodule + symbol, the symtree only has "submod", so adjust that here. */ - st0 = gfc_find_symtree (*root, name); + p = strrchr(name, '.'); + if (p) + p++; + else + p = name; + + st0 = gfc_find_symtree (*root, p); - st.name = gfc_get_string (name); + st.name = gfc_get_string ("%s", p); gfc_delete_bbt (root, &st, compare_symtree); free (st0); @@ -2770,7 +2857,7 @@ gfc_get_uop (const char *name) st = gfc_new_symtree (&ns->uop_root, name); uop = st->n.uop = XCNEW (gfc_user_op); - uop->name = gfc_get_string (name); + uop->name = gfc_get_string ("%s", name); uop->access = ACCESS_UNKNOWN; uop->ns = ns; @@ -2891,7 +2978,7 @@ gfc_new_symbol (const char *name, gfc_namespace *ns) if (strlen (name) > GFC_MAX_SYMBOL_LEN) gfc_internal_error ("new_symbol(): Symbol name too long"); - p->name = gfc_get_string (name); + p->name = gfc_get_string ("%s", name); /* Make sure flags for symbol being C bound are clear initially. */ p->attr.is_bind_c = 0; @@ -2901,6 +2988,7 @@ gfc_new_symbol (const char *name, gfc_namespace *ns) p->common_block = NULL; p->f2k_derived = NULL; p->assoc = NULL; + p->fn_result_spec = 0; return p; } @@ -2930,7 +3018,11 @@ select_type_insert_tmp (gfc_symtree **st) gfc_select_type_stack *stack = select_type_stack; for (; stack; stack = stack->prev) if ((*st)->n.sym == stack->selector && stack->tmp) - *st = stack->tmp; + { + *st = stack->tmp; + select_type_insert_tmp (st); + return; + } } @@ -3726,31 +3818,22 @@ gfc_charlen* gfc_new_charlen (gfc_namespace *ns, gfc_charlen *old_cl) { gfc_charlen *cl; + cl = gfc_get_charlen (); /* Copy old_cl. */ if (old_cl) { - /* Put into namespace, but don't allow reject_statement - to free it if old_cl is given. */ - gfc_charlen **prev = &ns->cl_list; - cl->next = ns->old_cl_list; - while (*prev != ns->old_cl_list) - prev = &(*prev)->next; - *prev = cl; - ns->old_cl_list = cl; cl->length = gfc_copy_expr (old_cl->length); cl->length_from_typespec = old_cl->length_from_typespec; cl->backend_decl = old_cl->backend_decl; cl->passed_length = old_cl->passed_length; cl->resolved = old_cl->resolved; } - else - { - /* Put into namespace. */ - cl->next = ns->cl_list; - ns->cl_list = cl; - } + + /* Put into namespace. */ + cl->next = ns->cl_list; + ns->cl_list = cl; return cl; } @@ -3987,6 +4070,10 @@ gfc_is_var_automatic (gfc_symbol *sym) && sym->ts.u.cl && !gfc_is_constant_expr (sym->ts.u.cl->length)) return true; + /* Variables with explicit AUTOMATIC attribute. */ + if (sym->attr.automatic) + return true; + return false; } @@ -4082,7 +4169,7 @@ gfc_get_gsymbol (const char *name) s = XCNEW (gfc_gsymbol); s->type = GSYM_UNKNOWN; - s->name = gfc_get_string (name); + s->name = gfc_get_string ("%s", name); gfc_insert_bbt (&gfc_gsym_root, s, gsym_compare); @@ -4545,7 +4632,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, } /* Say what module this symbol belongs to. */ - tmp_sym->module = gfc_get_string (mod_name); + tmp_sym->module = gfc_get_string ("%s", mod_name); tmp_sym->from_intmod = INTMOD_ISO_C_BINDING; tmp_sym->intmod_sym_id = s; tmp_sym->attr.is_iso_c = 1; @@ -4642,7 +4729,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, gfc_get_sym_tree (hidden_name, gfc_current_ns, &tmp_symtree, false); dt_sym = tmp_symtree->n.sym; dt_sym->name = gfc_get_string (s == ISOCBINDING_PTR - ? "c_ptr" : "c_funptr"); + ? "c_ptr" : "c_funptr"); /* Generate an artificial generic function. */ head = tmp_sym->generic; @@ -4662,7 +4749,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, } /* Say what module this symbol belongs to. */ - dt_sym->module = gfc_get_string (mod_name); + dt_sym->module = gfc_get_string ("%s", mod_name); dt_sym->from_intmod = INTMOD_ISO_C_BINDING; dt_sym->intmod_sym_id = s; dt_sym->attr.use_assoc = 1; @@ -4861,7 +4948,7 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2) && !is_union1 && !is_union2) return (ts1->type == ts2->type); - if ((is_derived1 && is_derived2) || (is_union1 && is_union1)) + if ((is_derived1 && is_derived2) || (is_union1 && is_union2)) return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived); if (is_derived1 && is_class2) diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 0c71c3c805..d239cf114e 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -1,5 +1,5 @@ /* Simulate storage of variables into target memory. - Copyright (C) 2007-2016 Free Software Foundation, Inc. + Copyright (C) 2007-2017 Free Software Foundation, Inc. Contributed by Paul Thomas and Brooks Moses This file is part of GCC. @@ -639,7 +639,8 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, error. */ static size_t -expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len) +expr_to_char (gfc_expr *e, locus *loc, + unsigned char *data, unsigned char *chk, size_t len) { int i; int ptr; @@ -663,7 +664,7 @@ expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len) continue; ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl)) + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8; - expr_to_char (c->expr, &data[ptr], &chk[ptr], len); + expr_to_char (c->expr, loc, &data[ptr], &chk[ptr], len); } return len; } @@ -674,12 +675,16 @@ expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len) buffer = (unsigned char*)alloca (len); len = gfc_target_encode_expr (e, buffer, len); - for (i = 0; i < (int)len; i++) + for (i = 0; i < (int)len; i++) { if (chk[i] && (buffer[i] != data[i])) { - gfc_error ("Overlapping unequal initializers in EQUIVALENCE " - "at %L", &e->where); + if (loc) + gfc_error ("Overlapping unequal initializers in EQUIVALENCE " + "at %L", loc); + else + gfc_error ("Overlapping unequal initializers in EQUIVALENCE " + "at %C"); return 0; } chk[i] = 0xFF; @@ -695,7 +700,8 @@ expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len) the union declaration. */ size_t -gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data, +gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, locus *loc, + unsigned char *data, unsigned char *chk, size_t length) { size_t len = 0; @@ -705,8 +711,7 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data, { case EXPR_CONSTANT: case EXPR_STRUCTURE: - len = expr_to_char (e, &data[0], &chk[0], length); - + len = expr_to_char (e, loc, &data[0], &chk[0], length); break; case EXPR_ARRAY: @@ -718,7 +723,7 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data, if (mpz_cmp_si (c->offset, 0) != 0) len = elt_size * (size_t)mpz_get_si (c->offset); - len = len + gfc_merge_initializers (ts, c->expr, &data[len], + len = len + gfc_merge_initializers (ts, c->expr, loc, &data[len], &chk[len], length - len); } break; diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h index f83cc2163b..5d4655352c 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-2016 Free Software Foundation, Inc. + Copyright (C) 2007-2017 Free Software Foundation, Inc. Contributed by Paul Thomas and Brooks Moses This file is part of GCC. @@ -44,7 +44,7 @@ int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *); int gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *, bool); /* Merge overlapping equivalence initializers for trans-common.c. */ -size_t gfc_merge_initializers (gfc_typespec, gfc_expr *, +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.c index 0882a3a0e7..47e8c091a9 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1,5 +1,5 @@ /* Array translation routines - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -1094,6 +1094,16 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, info->descriptor = desc; size = gfc_index_one_node; + /* Emit a DECL_EXPR for the variable sized array type in + GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type + sizes works correctly. */ + tree arraytype = TREE_TYPE (GFC_TYPE_ARRAY_DATAPTR_TYPE (type)); + if (! TYPE_NAME (arraytype)) + TYPE_NAME (arraytype) = build_decl (UNKNOWN_LOCATION, TYPE_DECL, + NULL_TREE, arraytype); + gfc_add_expr_to_block (pre, build1 (DECL_EXPR, + arraytype, TYPE_NAME (arraytype))); + /* Fill in the array dtype. */ tmp = gfc_conv_descriptor_dtype (desc); gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); @@ -2216,6 +2226,8 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_ss_info *ss_info; gfc_expr *expr; gfc_ss *s; + tree neg_len; + char *msg; /* Save the old values for nested checking. */ old_first_len = first_len; @@ -2229,7 +2241,8 @@ trans_array_constructor (gfc_ss * ss, locus * where) /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no typespec was given for the array constructor. */ - typespec_chararray_ctor = (expr->ts.u.cl + typespec_chararray_ctor = (expr->ts.type == BT_CHARACTER + && expr->ts.u.cl && expr->ts.u.cl->length_from_typespec); if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) @@ -2260,6 +2273,29 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_conv_expr_type (&length_se, expr->ts.u.cl->length, gfc_charlen_type_node); ss_info->string_length = length_se.expr; + + /* Check if the character length is negative. If it is, then + set LEN = 0. */ + neg_len = fold_build2_loc (input_location, LT_EXPR, + boolean_type_node, ss_info->string_length, + build_int_cst (gfc_charlen_type_node, 0)); + /* Print a warning if bounds checking is enabled. */ + if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) + { + msg = xasprintf ("Negative character length treated as LEN = 0"); + gfc_trans_runtime_check (false, true, neg_len, &length_se.pre, + where, msg); + free (msg); + } + + ss_info->string_length + = fold_build3_loc (input_location, COND_EXPR, + gfc_charlen_type_node, neg_len, + build_int_cst (gfc_charlen_type_node, 0), + ss_info->string_length); + ss_info->string_length = gfc_evaluate_now (ss_info->string_length, + &length_se.pre); + gfc_add_block_to_block (&outer_loop->pre, &length_se.pre); gfc_add_block_to_block (&outer_loop->post, &length_se.post); } @@ -2281,7 +2317,8 @@ trans_array_constructor (gfc_ss * ss, locus * where) type = build_pointer_type (type); } else - type = gfc_typenode_for_spec (&expr->ts); + type = gfc_typenode_for_spec (expr->ts.type == BT_CLASS + ? &CLASS_DATA (expr)->ts : &expr->ts); /* See if the constructor determines the loop bounds. */ dynamic = false; @@ -2361,7 +2398,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) offsetvar, gfc_index_one_node); tmp = gfc_evaluate_now (tmp, &outer_loop->pre); gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp); - if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL) + if (*loop_ubound0 && VAR_P (*loop_ubound0)) gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp); else *loop_ubound0 = tmp; @@ -2669,6 +2706,20 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) if (base) { + if (ss_info->expr->ts.type == BT_CHARACTER && !ss_info->expr->ts.deferred + && ss_info->expr->ts.u.cl->length == NULL) + { + /* Emit a DECL_EXPR for the variable sized array type in + GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type + sizes works correctly. */ + tree arraytype = TREE_TYPE ( + GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (info->descriptor))); + if (! TYPE_NAME (arraytype)) + TYPE_NAME (arraytype) = build_decl (UNKNOWN_LOCATION, TYPE_DECL, + NULL_TREE, arraytype); + gfc_add_expr_to_block (block, build1 (DECL_EXPR, arraytype, + TYPE_NAME (arraytype))); + } /* Also the data pointer. */ tmp = gfc_conv_array_data (se.expr); /* If this is a variable or address of a variable we use it directly. @@ -2848,7 +2899,7 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, name = ss->info->expr->symtree->n.sym->name; gcc_assert (name != NULL); - if (TREE_CODE (descriptor) == VAR_DECL) + if (VAR_P (descriptor)) name = IDENTIFIER_POINTER (DECL_NAME (descriptor)); /* If upper bound is present, include both bounds in the error message. */ @@ -3025,50 +3076,57 @@ build_class_array_ref (gfc_se *se, tree base, tree index) tree type; tree size; tree offset; - tree decl; + tree decl = NULL_TREE; tree tmp; gfc_expr *expr = se->ss->info->expr; gfc_ref *ref; - gfc_ref *class_ref; + gfc_ref *class_ref = NULL; gfc_typespec *ts; - if (expr == NULL - || (expr->ts.type != BT_CLASS - && !gfc_is_alloc_class_array_function (expr))) - return false; - - if (expr->symtree && expr->symtree->n.sym->ts.type == BT_CLASS) - ts = &expr->symtree->n.sym->ts; + if (se->expr && DECL_P (se->expr) && DECL_LANG_SPECIFIC (se->expr) + && GFC_DECL_SAVED_DESCRIPTOR (se->expr) + && GFC_CLASS_TYPE_P (TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (se->expr)))) + decl = se->expr; else - ts = NULL; - class_ref = NULL; - - for (ref = expr->ref; ref; ref = ref->next) { - if (ref->type == REF_COMPONENT - && ref->u.c.component->ts.type == BT_CLASS - && ref->next && ref->next->type == REF_COMPONENT - && strcmp (ref->next->u.c.component->name, "_data") == 0 - && ref->next->next - && ref->next->next->type == REF_ARRAY - && ref->next->next->u.ar.type != AR_ELEMENT) + if (expr == NULL + || (expr->ts.type != BT_CLASS + && !gfc_is_alloc_class_array_function (expr) + && !gfc_is_class_array_ref (expr, NULL))) + return false; + + if (expr->symtree && expr->symtree->n.sym->ts.type == BT_CLASS) + ts = &expr->symtree->n.sym->ts; + else + ts = NULL; + + for (ref = expr->ref; ref; ref = ref->next) { - ts = &ref->u.c.component->ts; - class_ref = ref; - break; + if (ref->type == REF_COMPONENT + && ref->u.c.component->ts.type == BT_CLASS + && ref->next && ref->next->type == REF_COMPONENT + && strcmp (ref->next->u.c.component->name, "_data") == 0 + && ref->next->next + && ref->next->next->type == REF_ARRAY + && ref->next->next->u.ar.type != AR_ELEMENT) + { + ts = &ref->u.c.component->ts; + class_ref = ref; + break; + } } - } - if (ts == NULL) - return false; + if (ts == NULL) + return false; + } - if (class_ref == NULL && expr->symtree->n.sym->attr.function + if (class_ref == NULL && expr && expr->symtree->n.sym->attr.function && expr->symtree->n.sym == expr->symtree->n.sym->result) { gcc_assert (expr->symtree->n.sym->backend_decl == current_function_decl); decl = gfc_get_fake_result_decl (expr->symtree->n.sym, 0); } - else if (gfc_is_alloc_class_array_function (expr)) + else if (expr && gfc_is_alloc_class_array_function (expr)) { size = NULL_TREE; decl = NULL_TREE; @@ -3085,7 +3143,7 @@ build_class_array_ref (gfc_se *se, tree base, tree index) else type = NULL_TREE; } - if (TREE_CODE (tmp) == VAR_DECL) + if (VAR_P (tmp)) break; } @@ -3094,7 +3152,8 @@ build_class_array_ref (gfc_se *se, tree base, tree index) } else if (class_ref == NULL) { - decl = expr->symtree->n.sym->backend_decl; + if (decl == NULL_TREE) + decl = expr->symtree->n.sym->backend_decl; /* For class arrays the tree containing the class is stored in GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl. For all others it's sym's backend_decl directly. */ @@ -3110,6 +3169,7 @@ build_class_array_ref (gfc_se *se, tree base, tree index) class_ref->next = NULL; gfc_init_se (&tmpse, NULL); gfc_conv_expr (&tmpse, expr); + gfc_add_block_to_block (&se->pre, &tmpse.pre); decl = tmpse.expr; class_ref->next = ref; } @@ -3122,9 +3182,22 @@ build_class_array_ref (gfc_se *se, tree base, tree index) size = gfc_class_vtab_size_get (decl); + /* For unlimited polymorphic entities then _len component needs to be + multiplied with the size. If no _len component is present, then + gfc_class_len_or_zero_get () return a zero_node. */ + tmp = gfc_class_len_or_zero_get (decl); + if (!integer_zerop (tmp)) + size = fold_build2 (MULT_EXPR, TREE_TYPE (index), + fold_convert (TREE_TYPE (index), size), + fold_build2 (MAX_EXPR, TREE_TYPE (index), + fold_convert (TREE_TYPE (index), tmp), + fold_convert (TREE_TYPE (index), + integer_one_node))); + else + size = fold_convert (TREE_TYPE (index), size); + /* Build the address of the element. */ type = TREE_TYPE (TREE_TYPE (base)); - size = fold_convert (TREE_TYPE (index), size); offset = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, index, size); @@ -3322,7 +3395,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, if (ref->type == REF_ARRAY && &ref->u.ar == ar) break; if (ref->type == REF_COMPONENT) - len += 1 + strlen (ref->u.c.component->name); + len += 2 + strlen (ref->u.c.component->name); } var_name = XALLOCAVEC (char, len); @@ -4021,6 +4094,7 @@ done: continue; } /* Otherwise fall through GFC_SS_FUNCTION. */ + gcc_fallthrough (); } case GFC_ISYM_LCOBOUND: case GFC_ISYM_UCOBOUND: @@ -4031,6 +4105,7 @@ done: continue; } + /* FALLTHRU */ case GFC_SS_CONSTRUCTOR: case GFC_SS_FUNCTION: for (n = 0; n < ss->dimen; n++) @@ -5071,19 +5146,20 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, stride = gfc_index_one_node; offset = gfc_index_zero_node; - /* Set the dtype. */ - if (expr->ts.type == BT_CHARACTER && expr->ts.deferred - && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL) + /* Set the dtype before the alloc, because registration of coarrays needs + it initialized. */ + if (expr->ts.type == BT_CHARACTER + && expr->ts.deferred + && VAR_P (expr->ts.u.cl->backend_decl)) { type = gfc_typenode_for_spec (&expr->ts); tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (descriptor_block, tmp, - gfc_get_dtype_rank_type (rank, type)); + gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type)); } else { tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (type)); + gfc_add_modify (pblock, tmp, gfc_get_dtype (type)); } or_expr = boolean_false_node; @@ -5392,8 +5468,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, stmtblock_t elseblock; gfc_expr **lower; gfc_expr **upper; - gfc_ref *ref, *prev_ref = NULL; - bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false; + gfc_ref *ref, *prev_ref = NULL, *coref; + bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false, + non_ulimate_coarray_ptr_comp; ref = expr->ref; @@ -5406,16 +5483,32 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (!prev_ref) { allocatable = expr->symtree->n.sym->attr.allocatable; - coarray = expr->symtree->n.sym->attr.codimension; dimension = expr->symtree->n.sym->attr.dimension; + non_ulimate_coarray_ptr_comp = false; } else { allocatable = prev_ref->u.c.component->attr.allocatable; - coarray = prev_ref->u.c.component->attr.codimension; + /* Pointer components in coarrayed derived types must be treated + specially in that they are registered without a check if the are + already associated. This does not hold for ultimate coarray + pointers. */ + non_ulimate_coarray_ptr_comp = (prev_ref->u.c.component->attr.pointer + && !prev_ref->u.c.component->attr.codimension); dimension = prev_ref->u.c.component->attr.dimension; } + /* For allocatable/pointer arrays in derived types, one of the refs has to be + a coarray. In this case it does not matter whether we are on this_image + or not. */ + coarray = false; + for (coref = expr->ref; coref; coref = coref->next) + if (coref->type == REF_ARRAY && coref->u.ar.codimen > 0) + { + coarray = true; + break; + } + if (!dimension) gcc_assert (coarray); @@ -5470,6 +5563,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, overflow = integer_zero_node; gfc_init_block (&set_descriptor_block); + /* Take the corank only from the actual ref and not from the coref. The + later will mislead the generation of the array dimensions for allocatable/ + pointer components in derived types. */ size = gfc_array_init_size (se->expr, alloc_w_e3_arr_spec ? expr->rank : ref->u.ar.as->rank, coarray ? ref->u.ar.as->corank : 0, @@ -5511,17 +5607,27 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (POINTER_TYPE_P (TREE_TYPE (se->expr))) se->expr = build_fold_indirect_ref_loc (input_location, se->expr); - pointer = gfc_conv_descriptor_data_get (se->expr); - STRIP_NOPS (pointer); - if (coarray && flag_coarray == GFC_FCOARRAY_LIB) - token = gfc_build_addr_expr (NULL_TREE, - gfc_conv_descriptor_token (se->expr)); + { + pointer = non_ulimate_coarray_ptr_comp ? se->expr + : gfc_conv_descriptor_data_get (se->expr); + token = gfc_conv_descriptor_token (se->expr); + token = gfc_build_addr_expr (NULL_TREE, token); + } + else + pointer = gfc_conv_descriptor_data_get (se->expr); + STRIP_NOPS (pointer); /* The allocatable variant takes the old pointer as first argument. */ if (allocatable) gfc_allocate_allocatable (&elseblock, pointer, size, token, - status, errmsg, errlen, label_finish, expr); + status, errmsg, errlen, label_finish, expr, + coref != NULL ? coref->u.ar.as->corank : 0); + else if (non_ulimate_coarray_ptr_comp && token) + /* The token is set only for GFC_FCOARRAY_LIB mode. */ + gfc_allocate_using_caf_lib (&elseblock, pointer, size, token, status, + errmsg, errlen, + GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY); else gfc_allocate_using_malloc (&elseblock, pointer, size, status); @@ -5550,70 +5656,17 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, build_int_cst (TREE_TYPE (status), 0)); gfc_add_expr_to_block (&se->pre, fold_build3_loc (input_location, COND_EXPR, void_type_node, - gfc_likely (cond, PRED_FORTRAN_FAIL_ALLOC), + cond, set_descriptor, build_empty_stmt (input_location))); } else gfc_add_expr_to_block (&se->pre, set_descriptor); - if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp - && !coarray) - { - tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, se->expr, - ref->u.ar.as->rank); - gfc_add_expr_to_block (&se->pre, tmp); - } - return true; } -/* Deallocate an array variable. Also used when an allocated variable goes - out of scope. */ -/*GCC ARRAYS*/ - -tree -gfc_array_deallocate (tree descriptor, tree pstat, tree errmsg, tree errlen, - tree label_finish, gfc_expr* expr) -{ - tree var; - tree tmp; - stmtblock_t block; - bool coarray = gfc_is_coarray (expr); - - gfc_start_block (&block); - - /* Get a pointer to the data. */ - var = gfc_conv_descriptor_data_get (descriptor); - STRIP_NOPS (var); - - /* Parameter is the address of the data component. */ - tmp = gfc_deallocate_with_status (coarray ? descriptor : var, pstat, errmsg, - errlen, label_finish, false, expr, coarray); - gfc_add_expr_to_block (&block, tmp); - - /* Zero the data pointer; only for coarrays an error can occur and then - the allocation status may not be changed. */ - tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, - var, build_int_cst (TREE_TYPE (var), 0)); - if (pstat != NULL_TREE && coarray && flag_coarray == GFC_FCOARRAY_LIB) - { - tree cond; - tree stat = build_fold_indirect_ref_loc (input_location, pstat); - - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - stat, build_int_cst (TREE_TYPE (stat), 0)); - tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - cond, tmp, build_empty_stmt (input_location)); - } - - gfc_add_expr_to_block (&block, tmp); - - return gfc_finish_block (&block); -} - - /* Create an array constructor from an initialization expression. We assume the frontend already did any expansions and conversions. */ @@ -5930,7 +5983,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, /* Don't actually allocate space for Cray Pointees. */ if (sym->attr.cray_pointee) { - if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) + if (VAR_P (GFC_TYPE_ARRAY_OFFSET (type))) gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset); gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); @@ -5963,7 +6016,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, } /* Set offset of the array. */ - if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) + if (VAR_P (GFC_TYPE_ARRAY_OFFSET (type))) gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset); /* Automatic arrays should not have initializers. */ @@ -6016,14 +6069,14 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block) gfc_start_block (&init); if (sym->ts.type == BT_CHARACTER - && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL) + && VAR_P (sym->ts.u.cl->backend_decl)) gfc_conv_string_length (sym->ts.u.cl, NULL, &init); /* Evaluate the bounds of the array. */ gfc_trans_array_bounds (type, sym, &offset, &init); /* Set the offset. */ - if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) + if (VAR_P (GFC_TYPE_ARRAY_OFFSET (type))) gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset); /* Set the pointer itself if we aren't using the parameter directly. */ @@ -6122,7 +6175,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, gfc_start_block (&init); if (sym->ts.type == BT_CHARACTER - && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL) + && VAR_P (sym->ts.u.cl->backend_decl)) gfc_conv_string_length (sym->ts.u.cl, NULL, &init); checkparm = (as->type == AS_EXPLICIT @@ -6346,7 +6399,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, gfc_trans_array_cobounds (type, &init, sym); /* Set the offset. */ - if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL) + if (VAR_P (GFC_TYPE_ARRAY_OFFSET (type))) gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset); gfc_trans_vla_type_sizes (sym, &init); @@ -6935,6 +6988,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) /* TODO: Optimize passing function return values. */ gfc_se lse; gfc_se rse; + bool deep_copy; /* Start the copying loops. */ gfc_mark_ss_chain_used (loop.temp_ss, 1); @@ -6965,9 +7019,12 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) gfc_add_block_to_block (&block, &lse.pre); lse.string_length = rse.string_length; + + deep_copy = !se->data_not_needed + && (expr->expr_type == EXPR_VARIABLE + || expr->expr_type == EXPR_ARRAY); tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, - expr->expr_type == EXPR_VARIABLE - || expr->expr_type == EXPR_ARRAY, false); + deep_copy, false); gfc_add_expr_to_block (&block, tmp); /* Finish the copying loops. */ @@ -7062,6 +7119,28 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) loop.from, loop.to, 0, GFC_ARRAY_UNKNOWN, false); parm = gfc_create_var (parmtype, "parm"); + + /* When expression is a class object, then add the class' handle to + the parm_decl. */ + if (expr->ts.type == BT_CLASS && expr->expr_type == EXPR_VARIABLE) + { + gfc_expr *class_expr = gfc_find_and_cut_at_last_class_ref (expr); + gfc_se classse; + + /* class_expr can be NULL, when no _class ref is in expr. + We must not fix this here with a gfc_fix_class_ref (). */ + if (class_expr) + { + gfc_init_se (&classse, NULL); + gfc_conv_expr (&classse, class_expr); + gfc_free_expr (class_expr); + + gcc_assert (classse.pre.head == NULL_TREE + && classse.post.head == NULL_TREE); + gfc_allocate_lang_decl (parm); + GFC_DECL_SAVED_DESCRIPTOR (parm) = classse.expr; + } + } } offset = gfc_index_zero_node; @@ -7223,6 +7302,13 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) : base; gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp); } + else if (IS_CLASS_ARRAY (expr) && !se->data_not_needed + && (!rank_remap || se->use_offset) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) + { + gfc_conv_descriptor_offset_set (&loop.pre, parm, + gfc_conv_descriptor_offset_get (desc)); + } else if (onebased && (!rank_remap || se->use_offset) && expr->symtree && !(expr->symtree->n.sym && expr->symtree->n.sym->ts.type == BT_CLASS @@ -7258,6 +7344,18 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) GFC_DECL_SAVED_DESCRIPTOR (expr->symtree->n.sym->backend_decl) : expr->symtree->n.sym->backend_decl; } + else if (expr->expr_type == EXPR_ARRAY && VAR_P (desc) + && IS_CLASS_ARRAY (expr)) + { + tree vtype; + gfc_allocate_lang_decl (desc); + tmp = gfc_create_var (expr->ts.u.derived->backend_decl, "class"); + GFC_DECL_SAVED_DESCRIPTOR (desc) = tmp; + vtype = gfc_class_vptr_get (tmp); + gfc_add_modify (&se->pre, vtype, + gfc_build_addr_expr (TREE_TYPE (vtype), + gfc_find_vtab (&expr->ts)->backend_decl)); + } if (!se->direct_byref || se->byref_noassign) { /* Get a pointer to the new descriptor. */ @@ -7676,37 +7774,6 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, } -/* Generate code to deallocate an array, if it is allocated. */ - -tree -gfc_trans_dealloc_allocated (tree descriptor, bool coarray, gfc_expr *expr) -{ - tree tmp; - tree var; - stmtblock_t block; - - gfc_start_block (&block); - - var = gfc_conv_descriptor_data_get (descriptor); - STRIP_NOPS (var); - - /* Call array_deallocate with an int * present in the second argument. - Although it is ignored here, it's presence ensures that arrays that - are already deallocated are ignored. */ - tmp = gfc_deallocate_with_status (coarray ? descriptor : var, NULL_TREE, - NULL_TREE, NULL_TREE, NULL_TREE, true, - expr, coarray); - gfc_add_expr_to_block (&block, tmp); - - /* Zero the data pointer. */ - tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, - var, build_int_cst (TREE_TYPE (var), 0)); - gfc_add_expr_to_block (&block, tmp); - - return gfc_finish_block (&block); -} - - /* This helper function calculates the size in words of a full array. */ tree @@ -7752,9 +7819,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest))) { - tmp = null_pointer_node; - tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, dest, tmp); - gfc_add_expr_to_block (&block, tmp); + gfc_add_modify (&block, dest, fold_convert (type, null_pointer_node)); null_data = gfc_finish_block (&block); gfc_init_block (&block); @@ -7766,9 +7831,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, if (!no_malloc) { tmp = gfc_call_malloc (&block, type, size); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, - dest, fold_convert (type, tmp)); - gfc_add_expr_to_block (&block, tmp); + gfc_add_modify (&block, dest, fold_convert (type, tmp)); } if (!no_memcpy) @@ -7864,17 +7927,154 @@ gfc_duplicate_allocatable_nocopy (tree dest, tree src, tree type, int rank) } +static tree +duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src, + tree type, int rank) +{ + tree tmp; + tree size; + tree nelems; + tree null_cond; + tree null_data; + stmtblock_t block, globalblock; + + /* If the source is null, set the destination to null. Then, + allocate memory to the destination. */ + gfc_init_block (&block); + gfc_init_block (&globalblock); + + if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest))) + { + gfc_se se; + symbol_attribute attr; + tree dummy_desc; + + gfc_init_se (&se, NULL); + gfc_clear_attr (&attr); + attr.allocatable = 1; + dummy_desc = gfc_conv_scalar_to_descriptor (&se, dest, attr); + gfc_add_block_to_block (&globalblock, &se.pre); + size = TYPE_SIZE_UNIT (TREE_TYPE (type)); + + gfc_add_modify (&block, dest, fold_convert (type, null_pointer_node)); + gfc_allocate_using_caf_lib (&block, dummy_desc, size, + gfc_build_addr_expr (NULL_TREE, dest_tok), + NULL_TREE, NULL_TREE, NULL_TREE, + GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY); + null_data = gfc_finish_block (&block); + + gfc_init_block (&block); + + gfc_allocate_using_caf_lib (&block, dummy_desc, + fold_convert (size_type_node, size), + gfc_build_addr_expr (NULL_TREE, dest_tok), + NULL_TREE, NULL_TREE, NULL_TREE, + GFC_CAF_COARRAY_ALLOC); + + tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); + tmp = build_call_expr_loc (input_location, tmp, 3, dest, src, + fold_convert (size_type_node, size)); + gfc_add_expr_to_block (&block, tmp); + } + else + { + /* Set the rank or unitialized memory access may be reported. */ + tmp = gfc_conv_descriptor_dtype (dest); + gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), rank)); + + if (rank) + nelems = gfc_full_array_size (&block, src, rank); + else + nelems = integer_one_node; + + tmp = fold_convert (size_type_node, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + size = fold_build2_loc (input_location, MULT_EXPR, size_type_node, + fold_convert (size_type_node, nelems), tmp); + + gfc_conv_descriptor_data_set (&block, dest, null_pointer_node); + gfc_allocate_using_caf_lib (&block, dest, fold_convert (size_type_node, + size), + gfc_build_addr_expr (NULL_TREE, dest_tok), + NULL_TREE, NULL_TREE, NULL_TREE, + GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY); + null_data = gfc_finish_block (&block); + + gfc_init_block (&block); + gfc_allocate_using_caf_lib (&block, dest, + fold_convert (size_type_node, size), + gfc_build_addr_expr (NULL_TREE, dest_tok), + NULL_TREE, NULL_TREE, NULL_TREE, + GFC_CAF_COARRAY_ALLOC); + + tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); + tmp = build_call_expr_loc (input_location, tmp, 3, + gfc_conv_descriptor_data_get (dest), + gfc_conv_descriptor_data_get (src), + fold_convert (size_type_node, size)); + gfc_add_expr_to_block (&block, tmp); + } + + tmp = gfc_finish_block (&block); + + /* Null the destination if the source is null; otherwise do + the register and copy. */ + if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src))) + null_cond = src; + else + null_cond = gfc_conv_descriptor_data_get (src); + + null_cond = convert (pvoid_type_node, null_cond); + null_cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + null_cond, null_pointer_node); + gfc_add_expr_to_block (&globalblock, build3_v (COND_EXPR, null_cond, tmp, + null_data)); + return gfc_finish_block (&globalblock); +} + + +/* Helper function to abstract whether coarray processing is enabled. */ + +static bool +caf_enabled (int caf_mode) +{ + return (caf_mode & GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY) + == GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY; +} + + +/* Helper function to abstract whether coarray processing is enabled + and we are in a derived type coarray. */ + +static bool +caf_in_coarray (int caf_mode) +{ + static const int pat = GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY + | GFC_STRUCTURE_CAF_MODE_IN_COARRAY; + return (caf_mode & pat) == pat; +} + + +/* Helper function to abstract whether coarray is to deallocate only. */ + +bool +gfc_caf_is_dealloc_only (int caf_mode) +{ + return (caf_mode & GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY) + == GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY; +} + + /* Recursively traverse an object of derived type, generating code to deallocate, nullify or copy allocatable components. This is the work horse function for the functions named in this enum. */ -enum {DEALLOCATE_ALLOC_COMP = 1, DEALLOCATE_ALLOC_COMP_NO_CAF, - NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP, COPY_ONLY_ALLOC_COMP, - COPY_ALLOC_COMP_CAF}; +enum {DEALLOCATE_ALLOC_COMP = 1, NULLIFY_ALLOC_COMP, + COPY_ALLOC_COMP, COPY_ONLY_ALLOC_COMP, REASSIGN_CAF_COMP}; static tree structure_alloc_comps (gfc_symbol * der_type, tree decl, - tree dest, int rank, int purpose) + tree dest, int rank, int purpose, int caf_mode) { gfc_component *c; gfc_loopinfo loop; @@ -7893,7 +8093,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree vref, dref; tree null_cond = NULL_TREE; tree add_when_allocated; - bool called_dealloc_with_status; + tree dealloc_fndecl; + tree caf_token; + gfc_symbol *vtab; + int caf_dereg_mode; + symbol_attribute *attr; + bool deallocate_called; gfc_init_block (&fnblock); @@ -7906,10 +8111,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, /* Deref dest in sync with decl, but only when it is not NULL. */ if (dest) dest = build_fold_indirect_ref_loc (input_location, dest); - } - /* Just in case it gets dereferenced. */ - decl_type = TREE_TYPE (decl); + /* Update the decl_type because it got dereferenced. */ + decl_type = TREE_TYPE (decl); + } /* If this is an array of derived types with allocatable components build a loop and recursively call this function. */ @@ -7951,16 +8156,18 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, vref = gfc_build_array_ref (var, index, NULL); - if (purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP) - { + if ((purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP) + && !caf_enabled (caf_mode)) + { tmp = build_fold_indirect_ref_loc (input_location, gfc_conv_array_data (dest)); dref = gfc_build_array_ref (tmp, index, NULL); tmp = structure_alloc_comps (der_type, vref, dref, rank, - COPY_ALLOC_COMP); + COPY_ALLOC_COMP, 0); } else - tmp = structure_alloc_comps (der_type, vref, NULL_TREE, rank, purpose); + tmp = structure_alloc_comps (der_type, vref, NULL_TREE, rank, purpose, + caf_mode); gfc_add_expr_to_block (&loopbody, tmp); @@ -7998,96 +8205,206 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, bool cmp_has_alloc_comps = (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) && c->ts.u.derived->attr.alloc_comp; + bool same_type = (c->ts.type == BT_DERIVED && der_type == c->ts.u.derived) + || (c->ts.type == BT_CLASS && der_type == CLASS_DATA (c)->ts.u.derived); + cdecl = c->backend_decl; ctype = TREE_TYPE (cdecl); switch (purpose) { case DEALLOCATE_ALLOC_COMP: - case DEALLOCATE_ALLOC_COMP_NO_CAF: - /* gfc_deallocate_scalar_with_status calls gfc_deallocate_alloc_comp - (i.e. this function) so generate all the calls and suppress the - recursion from here, if necessary. */ - called_dealloc_with_status = false; gfc_init_block (&tmpblock); - if ((c->ts.type == BT_DERIVED && !c->attr.pointer) - || (c->ts.type == BT_CLASS && !CLASS_DATA (c)->attr.class_pointer)) - { - comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, - decl, cdecl, NULL_TREE); + comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, + decl, cdecl, NULL_TREE); - /* The finalizer frees allocatable components. */ - called_dealloc_with_status - = gfc_add_comp_finalizer_call (&tmpblock, comp, c, - purpose == DEALLOCATE_ALLOC_COMP); + /* Shortcut to get the attributes of the component. */ + if (c->ts.type == BT_CLASS) + { + attr = &CLASS_DATA (c)->attr; + if (attr->class_pointer) + continue; + } + else + { + attr = &c->attr; + if (attr->pointer) + continue; } + + if ((c->ts.type == BT_DERIVED && !c->attr.pointer) + || (c->ts.type == BT_CLASS && !CLASS_DATA (c)->attr.class_pointer)) + /* Call the finalizer, which will free the memory and nullify the + pointer of an array. */ + deallocate_called = gfc_add_comp_finalizer_call (&tmpblock, comp, c, + caf_enabled (caf_mode)) + && attr->dimension; else - comp = NULL_TREE; + deallocate_called = false; - if (c->attr.allocatable && !c->attr.proc_pointer - && (c->attr.dimension - || (c->attr.codimension - && purpose != DEALLOCATE_ALLOC_COMP_NO_CAF))) + /* Add the _class ref for classes. */ + if (c->ts.type == BT_CLASS && attr->allocatable) + comp = gfc_class_data_get (comp); + + add_when_allocated = NULL_TREE; + if (cmp_has_alloc_comps + && !c->attr.pointer && !c->attr.proc_pointer + && !same_type + && !deallocate_called) { - if (comp == NULL_TREE) - comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, - decl, cdecl, NULL_TREE); - tmp = gfc_trans_dealloc_allocated (comp, c->attr.codimension, NULL); - gfc_add_expr_to_block (&tmpblock, tmp); + /* Add checked deallocation of the components. This code is + obviously added because the finalizer is not trusted to free + all memory. */ + if (c->ts.type == BT_CLASS) + { + rank = CLASS_DATA (c)->as ? CLASS_DATA (c)->as->rank : 0; + add_when_allocated + = structure_alloc_comps (CLASS_DATA (c)->ts.u.derived, + comp, NULL_TREE, rank, purpose, + caf_mode); + } + else + { + rank = c->as ? c->as->rank : 0; + add_when_allocated = structure_alloc_comps (c->ts.u.derived, + comp, NULL_TREE, + rank, purpose, + caf_mode); + } } - else if (c->attr.allocatable && !c->attr.codimension) + + if (attr->allocatable && !same_type + && (!attr->codimension || caf_enabled (caf_mode))) { - /* Allocatable scalar components. */ - if (comp == NULL_TREE) - comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, - decl, cdecl, NULL_TREE); + /* Handle all types of components besides components of the + same_type as the current one, because those would create an + endless loop. */ + caf_dereg_mode + = (caf_in_coarray (caf_mode) || attr->codimension) + ? (gfc_caf_is_dealloc_only (caf_mode) + ? GFC_CAF_COARRAY_DEALLOCATE_ONLY + : GFC_CAF_COARRAY_DEREGISTER) + : GFC_CAF_COARRAY_NOCOARRAY; + + caf_token = NULL_TREE; + /* Coarray components are handled directly by + deallocate_with_status. */ + if (!attr->codimension + && caf_dereg_mode != GFC_CAF_COARRAY_NOCOARRAY) + { + if (c->caf_token) + caf_token = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (c->caf_token), + decl, c->caf_token, NULL_TREE); + else if (attr->dimension && !attr->proc_pointer) + caf_token = gfc_conv_descriptor_token (comp); + } + if (attr->dimension && !attr->codimension && !attr->proc_pointer) + /* When this is an array but not in conjunction with a coarray + then add the data-ref. For coarray'ed arrays the data-ref + is added by deallocate_with_status. */ + comp = gfc_conv_descriptor_data_get (comp); - tmp = gfc_deallocate_scalar_with_status (comp, NULL, true, NULL, - c->ts); - gfc_add_expr_to_block (&tmpblock, tmp); - called_dealloc_with_status = true; + tmp = gfc_deallocate_with_status (comp, NULL_TREE, NULL_TREE, + NULL_TREE, NULL_TREE, true, + NULL, caf_dereg_mode, + add_when_allocated, caf_token); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - void_type_node, comp, - build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&tmpblock, tmp); } - else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable - && (!CLASS_DATA (c)->attr.codimension - || purpose != DEALLOCATE_ALLOC_COMP_NO_CAF)) + else if (attr->allocatable && !attr->codimension + && !deallocate_called) { - /* Allocatable CLASS components. */ - - /* Add reference to '_data' component. */ - tmp = CLASS_DATA (c)->backend_decl; - comp = fold_build3_loc (input_location, COMPONENT_REF, - TREE_TYPE (tmp), comp, tmp, NULL_TREE); - - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) - tmp = gfc_trans_dealloc_allocated (comp, - CLASS_DATA (c)->attr.codimension, NULL); + /* Case of recursive allocatable derived types. */ + tree is_allocated; + tree ubound; + tree cdesc; + stmtblock_t dealloc_block; + + gfc_init_block (&dealloc_block); + if (add_when_allocated) + gfc_add_expr_to_block (&dealloc_block, add_when_allocated); + + /* Convert the component into a rank 1 descriptor type. */ + if (attr->dimension) + { + tmp = gfc_get_element_type (TREE_TYPE (comp)); + ubound = gfc_full_array_size (&dealloc_block, comp, + c->ts.type == BT_CLASS + ? CLASS_DATA (c)->as->rank + : c->as->rank); + } else { - tmp = gfc_deallocate_scalar_with_status (comp, NULL_TREE, true, NULL, - CLASS_DATA (c)->ts); - gfc_add_expr_to_block (&tmpblock, tmp); - called_dealloc_with_status = true; - - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - void_type_node, comp, - build_int_cst (TREE_TYPE (comp), 0)); + tmp = TREE_TYPE (comp); + 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); + + cdesc = gfc_create_var (cdesc, "cdesc"); + DECL_ARTIFICIAL (cdesc) = 1; + + gfc_add_modify (&dealloc_block, gfc_conv_descriptor_dtype (cdesc), + gfc_get_dtype_rank_type (1, tmp)); + gfc_conv_descriptor_lbound_set (&dealloc_block, cdesc, + gfc_index_zero_node, + gfc_index_one_node); + gfc_conv_descriptor_stride_set (&dealloc_block, cdesc, + gfc_index_zero_node, + gfc_index_one_node); + gfc_conv_descriptor_ubound_set (&dealloc_block, cdesc, + gfc_index_zero_node, ubound); + + if (attr->dimension) + comp = gfc_conv_descriptor_data_get (comp); + + gfc_conv_descriptor_data_set (&dealloc_block, cdesc, comp); + + /* Now call the deallocator. */ + vtab = gfc_find_vtab (&c->ts); + if (vtab->backend_decl == NULL) + gfc_get_symbol_decl (vtab); + tmp = gfc_build_addr_expr (NULL_TREE, vtab->backend_decl); + dealloc_fndecl = gfc_vptr_deallocate_get (tmp); + dealloc_fndecl = build_fold_indirect_ref_loc (input_location, + dealloc_fndecl); + tmp = build_int_cst (TREE_TYPE (comp), 0); + is_allocated = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, tmp, + comp); + cdesc = gfc_build_addr_expr (NULL_TREE, cdesc); + + tmp = build_call_expr_loc (input_location, + dealloc_fndecl, 1, + cdesc); + gfc_add_expr_to_block (&dealloc_block, tmp); + + tmp = gfc_finish_block (&dealloc_block); + + tmp = fold_build3_loc (input_location, COND_EXPR, + void_type_node, is_allocated, tmp, + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&tmpblock, tmp); + } + else if (add_when_allocated) + gfc_add_expr_to_block (&tmpblock, add_when_allocated); + if (c->ts.type == BT_CLASS && attr->allocatable + && (!attr->codimension || !caf_enabled (caf_mode))) + { /* Finally, reset the vptr to the declared type vtable and, if necessary reset the _len field. First recover the reference to the component and obtain the vptr. */ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, - decl, cdecl, NULL_TREE); + decl, cdecl, NULL_TREE); tmp = gfc_class_vptr_get (comp); if (UNLIMITED_POLY (c)) @@ -8114,44 +8431,62 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, } } - if (cmp_has_alloc_comps - && !c->attr.pointer && !c->attr.proc_pointer - && !called_dealloc_with_status) - { - /* Do not deallocate the components of ultimate pointer - components or iteratively call self if call has been made - to gfc_trans_dealloc_allocated */ - comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, - decl, cdecl, NULL_TREE); - rank = c->as ? c->as->rank : 0; - tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE, - rank, purpose); - gfc_add_expr_to_block (&fnblock, tmp); - } - /* Now add the deallocation of this component. */ gfc_add_block_to_block (&fnblock, &tmpblock); break; case NULLIFY_ALLOC_COMP: - if (c->attr.pointer || c->attr.proc_pointer) + /* Nullify + - allocatable components (regular or in class) + - components that have allocatable components + - pointer components when in a coarray. + Skip everything else especially proc_pointers, which may come + coupled with the regular pointer attribute. */ + if (c->attr.proc_pointer + || !(c->attr.allocatable || (c->ts.type == BT_CLASS + && CLASS_DATA (c)->attr.allocatable) + || (cmp_has_alloc_comps + && ((c->ts.type == BT_DERIVED && !c->attr.pointer) + || (c->ts.type == BT_CLASS + && !CLASS_DATA (c)->attr.class_pointer))) + || (caf_in_coarray (caf_mode) && c->attr.pointer))) continue; - else if (c->attr.allocatable - && (c->attr.dimension|| c->attr.codimension)) + + /* Process class components first, because they always have the + pointer-attribute set which would be caught wrong else. */ + if (c->ts.type == BT_CLASS + && (CLASS_DATA (c)->attr.allocatable + || CLASS_DATA (c)->attr.class_pointer)) { + /* Allocatable CLASS components. */ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); - gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); + + comp = gfc_class_data_get (comp); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) + gfc_conv_descriptor_data_set (&fnblock, comp, + null_pointer_node); + else + { + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + void_type_node, comp, + build_int_cst (TREE_TYPE (comp), 0)); + gfc_add_expr_to_block (&fnblock, tmp); + } + cmp_has_alloc_comps = false; } - else if (c->attr.allocatable) + /* Coarrays need the component to be nulled before the api-call + is made. */ + else if (c->attr.pointer || c->attr.allocatable) { - /* Allocatable scalar components. */ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - void_type_node, comp, - build_int_cst (TREE_TYPE (comp), 0)); - gfc_add_expr_to_block (&fnblock, tmp); + if (c->attr.dimension || c->attr.codimension) + gfc_conv_descriptor_data_set (&fnblock, comp, + null_pointer_node); + else + gfc_add_modify (&fnblock, comp, + build_int_cst (TREE_TYPE (comp), 0)); if (gfc_deferred_strlen (c, &comp)) { comp = fold_build3_loc (input_location, COMPONENT_REF, @@ -8162,65 +8497,92 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&fnblock, tmp); } + cmp_has_alloc_comps = false; } - else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) + + if (flag_coarray == GFC_FCOARRAY_LIB + && (caf_in_coarray (caf_mode) || c->attr.codimension)) { - /* Allocatable CLASS components. */ + /* Register the component with the coarray library. */ + tree token; + comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); - /* Add reference to '_data' component. */ - tmp = CLASS_DATA (c)->backend_decl; - comp = fold_build3_loc (input_location, COMPONENT_REF, - TREE_TYPE (tmp), comp, tmp, NULL_TREE); - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) - gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); + if (c->attr.dimension || c->attr.codimension) + { + /* Set the dtype, because caf_register needs it. */ + gfc_add_modify (&fnblock, gfc_conv_descriptor_dtype (comp), + gfc_get_dtype (TREE_TYPE (comp))); + tmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, + decl, cdecl, NULL_TREE); + token = gfc_conv_descriptor_token (tmp); + } else { - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - void_type_node, comp, - build_int_cst (TREE_TYPE (comp), 0)); - gfc_add_expr_to_block (&fnblock, tmp); + gfc_se se; + + gfc_init_se (&se, NULL); + token = fold_build3_loc (input_location, COMPONENT_REF, + pvoid_type_node, decl, c->caf_token, + NULL_TREE); + comp = gfc_conv_scalar_to_descriptor (&se, comp, + c->ts.type == BT_CLASS + ? CLASS_DATA (c)->attr + : c->attr); + gfc_add_block_to_block (&fnblock, &se.pre); } + + gfc_allocate_using_caf_lib (&fnblock, comp, size_zero_node, + gfc_build_addr_expr (NULL_TREE, + token), + NULL_TREE, NULL_TREE, NULL_TREE, + GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY); } - else if (cmp_has_alloc_comps) + + if (cmp_has_alloc_comps) { comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); rank = c->as ? c->as->rank : 0; tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE, - rank, purpose); + rank, purpose, caf_mode); gfc_add_expr_to_block (&fnblock, tmp); } break; - case COPY_ALLOC_COMP_CAF: - if (!c->attr.codimension - && (c->ts.type != BT_CLASS || CLASS_DATA (c)->attr.coarray_comp) - && (c->ts.type != BT_DERIVED - || !c->ts.u.derived->attr.coarray_comp)) - continue; - - comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, - cdecl, NULL_TREE); - dcmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, dest, - cdecl, NULL_TREE); - - if (c->attr.codimension) + case REASSIGN_CAF_COMP: + if (caf_enabled (caf_mode) + && (c->attr.codimension + || (c->ts.type == BT_CLASS + && (CLASS_DATA (c)->attr.coarray_comp + || caf_in_coarray (caf_mode))) + || (c->ts.type == BT_DERIVED + && (c->ts.u.derived->attr.coarray_comp + || caf_in_coarray (caf_mode)))) + && !same_type) { - if (c->ts.type == BT_CLASS) + comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, + decl, cdecl, NULL_TREE); + dcmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, + dest, cdecl, NULL_TREE); + + if (c->attr.codimension) { - comp = gfc_class_data_get (comp); - dcmp = gfc_class_data_get (dcmp); - } - gfc_conv_descriptor_data_set (&fnblock, dcmp, + if (c->ts.type == BT_CLASS) + { + comp = gfc_class_data_get (comp); + dcmp = gfc_class_data_get (dcmp); + } + gfc_conv_descriptor_data_set (&fnblock, dcmp, gfc_conv_descriptor_data_get (comp)); - } - else - { - tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp, - rank, purpose); - gfc_add_expr_to_block (&fnblock, tmp); - + } + else + { + tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp, + rank, purpose, caf_mode + | GFC_STRUCTURE_CAF_MODE_IN_COARRAY); + gfc_add_expr_to_block (&fnblock, tmp); + } } break; @@ -8305,15 +8667,16 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, components that are really allocated, the deep copy code has to be generated first and then added to the if-block in gfc_duplicate_allocatable (). */ - if (cmp_has_alloc_comps - && !c->attr.proc_pointer) + if (cmp_has_alloc_comps && !c->attr.proc_pointer + && !same_type) { rank = c->as ? c->as->rank : 0; tmp = fold_convert (TREE_TYPE (dcmp), comp); gfc_add_modify (&fnblock, dcmp, tmp); add_when_allocated = structure_alloc_comps (c->ts.u.derived, comp, dcmp, - rank, purpose); + rank, purpose, + caf_mode); } else add_when_allocated = NULL_TREE; @@ -8339,13 +8702,25 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, false, false, size, NULL_TREE); gfc_add_expr_to_block (&fnblock, tmp); } - else if (c->attr.allocatable && !c->attr.proc_pointer - && (!(cmp_has_alloc_comps && c->as) - || c->attr.codimension)) + else if (c->attr.allocatable && !c->attr.proc_pointer && !same_type + && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension + || caf_in_coarray (caf_mode))) { rank = c->as ? c->as->rank : 0; if (c->attr.codimension) tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank); + else if (flag_coarray == GFC_FCOARRAY_LIB + && caf_in_coarray (caf_mode)) + { + tree dst_tok = c->as ? gfc_conv_descriptor_token (dcmp) + : fold_build3_loc (input_location, + COMPONENT_REF, + pvoid_type_node, dest, + c->caf_token, + NULL_TREE); + tmp = duplicate_allocatable_coarray (dcmp, dst_tok, comp, + ctype, rank); + } else tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank, add_when_allocated); @@ -8370,10 +8745,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, nullify allocatable components. */ tree -gfc_nullify_alloc_comp (gfc_symbol * der_type, tree decl, int rank) +gfc_nullify_alloc_comp (gfc_symbol * der_type, tree decl, int rank, + int caf_mode) { return structure_alloc_comps (der_type, decl, NULL_TREE, rank, - NULLIFY_ALLOC_COMP); + NULLIFY_ALLOC_COMP, + GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY | caf_mode); } @@ -8381,10 +8758,12 @@ gfc_nullify_alloc_comp (gfc_symbol * der_type, tree decl, int rank) deallocate allocatable components. */ tree -gfc_deallocate_alloc_comp (gfc_symbol * der_type, tree decl, int rank) +gfc_deallocate_alloc_comp (gfc_symbol * der_type, tree decl, int rank, + int caf_mode) { return structure_alloc_comps (der_type, decl, NULL_TREE, rank, - DEALLOCATE_ALLOC_COMP); + DEALLOCATE_ALLOC_COMP, + GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY | caf_mode); } @@ -8397,14 +8776,15 @@ tree gfc_deallocate_alloc_comp_no_caf (gfc_symbol * der_type, tree decl, int rank) { return structure_alloc_comps (der_type, decl, NULL_TREE, rank, - DEALLOCATE_ALLOC_COMP_NO_CAF); + DEALLOCATE_ALLOC_COMP, 0); } tree gfc_reassign_alloc_comp_caf (gfc_symbol *der_type, tree decl, tree dest) { - return structure_alloc_comps (der_type, decl, dest, 0, COPY_ALLOC_COMP_CAF); + return structure_alloc_comps (der_type, decl, dest, 0, REASSIGN_CAF_COMP, + GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY); } @@ -8412,9 +8792,11 @@ gfc_reassign_alloc_comp_caf (gfc_symbol *der_type, tree decl, tree dest) copy it and its allocatable components. */ tree -gfc_copy_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank) +gfc_copy_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank, + int caf_mode) { - return structure_alloc_comps (der_type, decl, dest, rank, COPY_ALLOC_COMP); + return structure_alloc_comps (der_type, decl, dest, rank, COPY_ALLOC_COMP, + caf_mode); } @@ -8424,7 +8806,8 @@ gfc_copy_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank) tree gfc_copy_only_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank) { - return structure_alloc_comps (der_type, decl, dest, rank, COPY_ONLY_ALLOC_COMP); + return structure_alloc_comps (der_type, decl, dest, rank, + COPY_ONLY_ALLOC_COMP, 0); } @@ -8509,6 +8892,14 @@ gfc_is_reallocatable_lhs (gfc_expr *expr) if (!expr->ref) return false; + /* An allocatable class variable with no reference. */ + if (expr->symtree->n.sym->ts.type == BT_CLASS + && CLASS_DATA (expr->symtree->n.sym)->attr.allocatable + && expr->ref && expr->ref->type == REF_COMPONENT + && strcmp (expr->ref->u.c.component->name, "_data") == 0 + && expr->ref->next == NULL) + return true; + /* An allocatable variable. */ if (expr->symtree->n.sym->attr.allocatable && expr->ref @@ -8647,6 +9038,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, int n; int dim; gfc_array_spec * as; + bool coarray = (flag_coarray == GFC_FCOARRAY_LIB + && gfc_caf_attr (expr1, true).codimension); + tree token; + gfc_se caf_se; /* x = f(...) with x allocatable. In this case, expr1 is the rhs. Find the lhs expression in the loop chain and set expr1 and @@ -8884,7 +9279,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tmp = gfc_conv_descriptor_offset (desc); gfc_add_modify (&fblock, tmp, offset); if (linfo->saved_offset - && TREE_CODE (linfo->saved_offset) == VAR_DECL) + && VAR_P (linfo->saved_offset)) gfc_add_modify (&fblock, linfo->saved_offset, tmp); /* Now set the deltas for the lhs. */ @@ -8895,8 +9290,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, tmp, loop->from[dim]); - if (linfo->delta[dim] - && TREE_CODE (linfo->delta[dim]) == VAR_DECL) + if (linfo->delta[dim] && VAR_P (linfo->delta[dim])) gfc_add_modify (&fblock, linfo->delta[dim], tmp); } @@ -8905,7 +9299,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, { if (expr2->ts.deferred) { - if (TREE_CODE (expr2->ts.u.cl->backend_decl) == VAR_DECL) + if (VAR_P (expr2->ts.u.cl->backend_decl)) tmp = expr2->ts.u.cl->backend_decl; else tmp = rss->info->string_length; @@ -8923,7 +9317,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, } if (expr1->ts.u.cl->backend_decl - && TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + && VAR_P (expr1->ts.u.cl->backend_decl)) gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); else gfc_add_modify (&fblock, lss->info->string_length, tmp); @@ -8961,11 +9355,32 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_modify (&fblock, tmp, gfc_get_dtype_rank_type (expr1->rank,type)); } + else if (coarray && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) + { + gfc_add_modify (&fblock, gfc_conv_descriptor_dtype (desc), + gfc_get_dtype (TREE_TYPE (desc))); + } /* Realloc expression. Note that the scalarizer uses desc.data in the array reference - (*desc.data)[<element>]. */ gfc_init_block (&realloc_block); + gfc_init_se (&caf_se, NULL); + + if (coarray) + { + token = gfc_get_ultimate_alloc_ptr_comps_caf_token (&caf_se, expr1); + if (token == NULL_TREE) + { + tmp = gfc_get_tree_for_caf_expr (expr1); + if (POINTER_TYPE_P (TREE_TYPE (tmp))) + tmp = build_fold_indirect_ref (tmp); + gfc_get_caf_token_offset (&caf_se, &token, NULL, tmp, NULL_TREE, + expr1); + token = gfc_build_addr_expr (NULL_TREE, token); + } + gfc_add_block_to_block (&realloc_block, &caf_se.pre); + } if ((expr1->ts.type == BT_DERIVED) && expr1->ts.u.derived->attr.alloc_comp) { @@ -8974,12 +9389,34 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_expr_to_block (&realloc_block, tmp); } - tmp = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_REALLOC), 2, - fold_convert (pvoid_type_node, array1), - size2); - gfc_conv_descriptor_data_set (&realloc_block, - desc, tmp); + if (!coarray) + { + tmp = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_REALLOC), 2, + fold_convert (pvoid_type_node, array1), + size2); + gfc_conv_descriptor_data_set (&realloc_block, + desc, tmp); + } + else + { + tmp = build_call_expr_loc (input_location, + gfor_fndecl_caf_deregister, 5, token, + build_int_cst (integer_type_node, + GFC_CAF_COARRAY_DEALLOCATE_ONLY), + null_pointer_node, null_pointer_node, + integer_zero_node); + gfc_add_expr_to_block (&realloc_block, tmp); + tmp = build_call_expr_loc (input_location, + gfor_fndecl_caf_register, + 7, size2, + build_int_cst (integer_type_node, + GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY), + token, gfc_build_addr_expr (NULL_TREE, desc), + null_pointer_node, null_pointer_node, + integer_zero_node); + gfc_add_expr_to_block (&realloc_block, tmp); + } if ((expr1->ts.type == BT_DERIVED) && expr1->ts.u.derived->attr.alloc_comp) @@ -8989,6 +9426,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_expr_to_block (&realloc_block, tmp); } + gfc_add_block_to_block (&realloc_block, &caf_se.post); realloc_expr = gfc_finish_block (&realloc_block); /* Only reallocate if sizes are different. */ @@ -8999,16 +9437,33 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Malloc expression. */ gfc_init_block (&alloc_block); - tmp = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MALLOC), - 1, size2); - gfc_conv_descriptor_data_set (&alloc_block, - desc, tmp); + if (!coarray) + { + tmp = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_MALLOC), + 1, size2); + gfc_conv_descriptor_data_set (&alloc_block, + desc, tmp); + } + else + { + tmp = build_call_expr_loc (input_location, + gfor_fndecl_caf_register, + 7, size2, + build_int_cst (integer_type_node, + GFC_CAF_COARRAY_ALLOC), + token, gfc_build_addr_expr (NULL_TREE, desc), + null_pointer_node, null_pointer_node, + integer_zero_node); + gfc_add_expr_to_block (&alloc_block, tmp); + } + /* We already set the dtype in the case of deferred character length arrays. */ if (!(GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)) - && expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)) + && ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) + || coarray))) { tmp = gfc_conv_descriptor_dtype (desc); gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc))); @@ -9032,8 +9487,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_expr_to_block (&fblock, tmp); /* Make sure that the scalarizer data pointer is updated. */ - if (linfo->data - && TREE_CODE (linfo->data) == VAR_DECL) + if (linfo->data && VAR_P (linfo->data)) { tmp = gfc_conv_descriptor_data_get (desc); gfc_add_modify (&fblock, linfo->data, tmp); @@ -9077,8 +9531,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) gfc_set_backend_locus (&sym->declared_at); gfc_init_block (&init); - gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL - || TREE_CODE (sym->backend_decl) == PARM_DECL); + gcc_assert (VAR_P (sym->backend_decl) + || TREE_CODE (sym->backend_decl) == PARM_DECL); if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.u.cl->backend_decl)) @@ -9142,7 +9596,20 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) /* NULLIFY the data pointer, for non-saved allocatables. */ if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save && sym->attr.allocatable) - gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node); + { + gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node); + if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension) + { + /* Declare the variable static so its array descriptor stays present + after leaving the scope. It may still be accessed through another + image. This may happen, for example, with the caf_mpi + implementation. */ + TREE_STATIC (descriptor) = 1; + tmp = gfc_conv_descriptor_token (descriptor); + gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp), + null_pointer_node)); + } + } gfc_restore_backend_locus (&loc); gfc_init_block (&cleanup); @@ -9176,8 +9643,11 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) { gfc_expr *e; e = has_finalizer ? gfc_lval_expr_from_sym (sym) : NULL; - tmp = gfc_trans_dealloc_allocated (sym->backend_decl, - sym->attr.codimension, e); + tmp = gfc_deallocate_with_status (sym->backend_decl, NULL_TREE, NULL_TREE, + NULL_TREE, NULL_TREE, true, e, + sym->attr.codimension + ? GFC_CAF_COARRAY_DEREGISTER + : GFC_CAF_COARRAY_NOCOARRAY); if (e) gfc_free_expr (e); gfc_add_expr_to_block (&cleanup, tmp); diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index d0309b2783..d87a9d8807 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-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -18,9 +18,6 @@ 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/>. */ -/* Generate code to free an array. */ -tree gfc_array_deallocate (tree, tree, tree, tree, tree, gfc_expr*); - /* Generate code to initialize and allocate an array. Statements are added to se, which should contain an expression for the array descriptor. */ bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree, tree, @@ -41,8 +38,6 @@ void gfc_trans_auto_array_allocation (tree, gfc_symbol *, gfc_wrapped_block *); void gfc_trans_dummy_array_bias (gfc_symbol *, tree, gfc_wrapped_block *); /* Generate entry and exit code for g77 calling convention arrays. */ void gfc_trans_g77_array (gfc_symbol *, gfc_wrapped_block *); -/* Generate code to deallocate an array, if it is allocated. */ -tree gfc_trans_dealloc_allocated (tree, bool, gfc_expr *); tree gfc_full_array_size (stmtblock_t *, tree, int); @@ -52,13 +47,15 @@ tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank); tree gfc_duplicate_allocatable_nocopy (tree, tree, tree, int); -tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int); +bool gfc_caf_is_dealloc_only (int); + +tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int, int cm = 0); -tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int); +tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int, int cm = 0); tree gfc_deallocate_alloc_comp_no_caf (gfc_symbol *, tree, int); tree gfc_reassign_alloc_comp_caf (gfc_symbol *, tree, tree); -tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int); +tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int, int); tree gfc_copy_only_alloc_comp (gfc_symbol *, tree, tree, int); diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 9467eac0c2..36370ebc22 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -1,5 +1,5 @@ /* Common block and equivalence list handling - Copyright (C) 2000-2016 Free Software Foundation, Inc. + Copyright (C) 2000-2017 Free Software Foundation, Inc. Contributed by Canqun Yang <canqun@nudt.edu.cn> This file is part of GCC. @@ -342,7 +342,7 @@ static tree build_equiv_decl (tree union_type, bool is_init, bool is_saved) { tree decl; - char name[15]; + char name[18]; static int serial = 0; if (is_init) @@ -408,7 +408,7 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) { DECL_SIZE (decl) = TYPE_SIZE (union_type); DECL_SIZE_UNIT (decl) = size; - DECL_MODE (decl) = TYPE_MODE (union_type); + SET_DECL_MODE (decl, TYPE_MODE (union_type)); TREE_TYPE (decl) = union_type; layout_decl (decl, 0); } @@ -436,7 +436,7 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) TREE_STATIC (decl) = 1; DECL_IGNORED_P (decl) = 1; if (!com->is_bind_c) - DECL_ALIGN (decl) = BIGGEST_ALIGNMENT; + SET_DECL_ALIGN (decl, BIGGEST_ALIGNMENT); else { /* Do not set the alignment for bind(c) common blocks to @@ -447,7 +447,7 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) tree field = NULL_TREE; field = TYPE_FIELDS (TREE_TYPE (decl)); if (DECL_CHAIN (field) == NULL_TREE) - DECL_ALIGN (decl) = TYPE_ALIGN (TREE_TYPE (field)); + SET_DECL_ALIGN (decl, TYPE_ALIGN (TREE_TYPE (field))); } DECL_USER_ALIGN (decl) = 0; GFC_DECL_COMMON_OR_EQUIV (decl) = 1; @@ -457,7 +457,11 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) if (com->threadprivate) set_decl_tls_model (decl, decl_default_tls_model (decl)); - if (com->omp_declare_target) + if (com->omp_declare_target_link) + DECL_ATTRIBUTES (decl) + = tree_cons (get_identifier ("omp declare target link"), + NULL_TREE, DECL_ATTRIBUTES (decl)); + else if (com->omp_declare_target) DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("omp declare target"), NULL_TREE, DECL_ATTRIBUTES (decl)); @@ -532,10 +536,15 @@ get_init_field (segment_info *head, tree union_type, tree *field_init, memset (chk, '\0', (size_t)length); for (s = head; s; s = s->next) if (s->sym->value) - gfc_merge_initializers (s->sym->ts, s->sym->value, + { + locus *loc = NULL; + if (s->sym->ns->equiv && s->sym->ns->equiv->eq) + loc = &s->sym->ns->equiv->eq->expr->where; + gfc_merge_initializers (s->sym->ts, s->sym->value, loc, &data[s->offset], &chk[s->offset], (size_t)s->length); + } for (i = 0; i < length; i++) CONSTRUCTOR_APPEND_ELT (v, NULL, build_int_cst (type, data[i])); @@ -800,13 +809,21 @@ element_number (gfc_array_ref *ar) if (ar->dimen_type[i] != DIMEN_ELEMENT) gfc_internal_error ("element_number(): Bad dimension type"); - mpz_sub (n, *get_mpz (ar->start[i]), *get_mpz (as->lower[i])); + if (as && as->lower[i]) + mpz_sub (n, *get_mpz (ar->start[i]), *get_mpz (as->lower[i])); + else + mpz_sub_ui (n, *get_mpz (ar->start[i]), 1); mpz_mul (n, n, multiplier); mpz_add (offset, offset, n); - mpz_sub (extent, *get_mpz (as->upper[i]), *get_mpz (as->lower[i])); - mpz_add_ui (extent, extent, 1); + if (as && as->upper[i] && as->lower[i]) + { + mpz_sub (extent, *get_mpz (as->upper[i]), *get_mpz (as->lower[i])); + mpz_add_ui (extent, extent, 1); + } + else + mpz_set_ui (extent, 0); if (mpz_sgn (extent) < 0) mpz_set_ui (extent, 0); @@ -1136,13 +1153,13 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list) if (warn_align_commons) { if (strcmp (common->name, BLANK_COMMON_NAME)) - gfc_warning (0, + gfc_warning (OPT_Walign_commons, "Padding of %d bytes required before %qs in " "COMMON %qs at %L; reorder elements or use " "-fno-align-commons", (int)offset, s->sym->name, common->name, &common->where); else - gfc_warning (0, + gfc_warning (OPT_Walign_commons, "Padding of %d bytes required before %qs in " "COMMON at %L; reorder elements or use " "-fno-align-commons", (int)offset, @@ -1229,8 +1246,12 @@ finish_equivalences (gfc_namespace *ns) { c = gfc_get_common_head (); /* We've lost the real location, so use the location of the - enclosing procedure. */ - c->where = ns->proc_name->declared_at; + enclosing procedure. If we're in a BLOCK DATA block, then + use the location in the sym_root. */ + if (ns->proc_name) + c->where = ns->proc_name->declared_at; + else if (ns->is_block_data) + c->where = ns->sym_root->n.sym->declared_at; strcpy (c->name, z->module); } else diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 812dcc6025..128d47d0fa 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -1,5 +1,5 @@ /* Translation of constants - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. diff --git a/gcc/fortran/trans-const.h b/gcc/fortran/trans-const.h index 14b0f791fd..97308676d1 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-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 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.c index 01756ed32c..efff9a15ac 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1,5 +1,5 @@ /* Backend function setup - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -45,6 +45,7 @@ along with GCC; see the file COPYING3. If not see /* Only for gfc_trans_code. Shouldn't need to include this. */ #include "trans-stmt.h" #include "gomp-constants.h" +#include "gimplify.h" #define MAX_LABEL_VALUE 99999 @@ -97,7 +98,6 @@ static int seen_ieee_symbol; tree gfor_fndecl_pause_numeric; tree gfor_fndecl_pause_string; tree gfor_fndecl_stop_numeric; -tree gfor_fndecl_stop_numeric_f08; tree gfor_fndecl_stop_string; tree gfor_fndecl_error_stop_numeric; tree gfor_fndecl_error_stop_string; @@ -134,6 +134,9 @@ tree gfor_fndecl_caf_deregister; tree gfor_fndecl_caf_get; tree gfor_fndecl_caf_send; tree gfor_fndecl_caf_sendget; +tree gfor_fndecl_caf_get_by_ref; +tree gfor_fndecl_caf_send_by_ref; +tree gfor_fndecl_caf_sendget_by_ref; tree gfor_fndecl_caf_sync_all; tree gfor_fndecl_caf_sync_memory; tree gfor_fndecl_caf_sync_images; @@ -150,11 +153,16 @@ tree gfor_fndecl_caf_unlock; tree gfor_fndecl_caf_event_post; tree gfor_fndecl_caf_event_wait; tree gfor_fndecl_caf_event_query; +tree gfor_fndecl_caf_fail_image; +tree gfor_fndecl_caf_failed_images; +tree gfor_fndecl_caf_image_status; +tree gfor_fndecl_caf_stopped_images; tree gfor_fndecl_co_broadcast; tree gfor_fndecl_co_max; tree gfor_fndecl_co_min; tree gfor_fndecl_co_reduce; tree gfor_fndecl_co_sum; +tree gfor_fndecl_caf_is_present; /* Math functions. Many other math functions are handled in @@ -270,7 +278,7 @@ gfc_build_label_decl (tree label_id) label_decl = build_decl (input_location, LABEL_DECL, label_id, void_type_node); DECL_CONTEXT (label_decl) = current_function_decl; - DECL_MODE (label_decl) = VOIDmode; + SET_DECL_MODE (label_decl, VOIDmode); /* We always define the label as used, even if the original source file never references the label. We don't want all kinds of @@ -351,12 +359,36 @@ gfc_sym_mangled_identifier (gfc_symbol * sym) if (sym->attr.is_bind_c == 1 && sym->binding_label) return get_identifier (sym->binding_label); - if (sym->module == NULL) - return gfc_sym_identifier (sym); + if (!sym->fn_result_spec) + { + if (sym->module == NULL) + return gfc_sym_identifier (sym); + else + { + snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name); + return get_identifier (name); + } + } else { - snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name); - return get_identifier (name); + /* This is an entity that is actually local to a module procedure + that appears in the result specification expression. Since + sym->module will be a zero length string, we use ns->proc_name + instead. */ + if (sym->ns->proc_name && sym->ns->proc_name->module) + { + snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s", + sym->ns->proc_name->module, + sym->ns->proc_name->name, + sym->name); + return get_identifier (name); + } + else + { + snprintf (name, sizeof name, "__%s_PROC_%s", + sym->ns->proc_name->name, sym->name); + return get_identifier (name); + } } } @@ -491,7 +523,7 @@ gfc_finish_decl (tree decl) gcc_assert (TREE_CODE (decl) == PARM_DECL || DECL_INITIAL (decl) == NULL_TREE); - if (TREE_CODE (decl) != VAR_DECL) + if (!VAR_P (decl)) return; if (DECL_SIZE (decl) == NULL_TREE @@ -610,6 +642,16 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) DECL_EXTERNAL (decl) = 1; TREE_PUBLIC (decl) = 1; } + else if (sym->fn_result_spec && !sym->ns->proc_name->module) + { + + if (sym->ns->proc_name->attr.if_source != IFSRC_DECL) + DECL_EXTERNAL (decl) = 1; + else + TREE_STATIC (decl) = 1; + + TREE_PUBLIC (decl) = 1; + } else if (sym->module && !sym->attr.result && !sym->attr.dummy) { /* TODO: Don't set sym->module for result or dummy variables. */ @@ -637,6 +679,16 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) && sym->attr.codimension && !sym->attr.allocatable))) TREE_STATIC (decl) = 1; + /* If derived-type variables with DTIO procedures are not made static + some bits of code referencing them get optimized away. + TODO Understand why this is so and fix it. */ + if (!sym->attr.use_assoc + && ((sym->ts.type == BT_DERIVED + && sym->ts.u.derived->attr.has_dtio_procs) + || (sym->ts.type == BT_CLASS + && CLASS_DATA (sym)->ts.u.derived->attr.has_dtio_procs))) + TREE_STATIC (decl) = 1; + if (sym->attr.volatile_) { TREE_THIS_VOLATILE (decl) = 1; @@ -646,7 +698,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) } /* Keep variables larger than max-stack-var-size off stack. */ - if (!sym->ns->proc_name->attr.recursive + if (!sym->ns->proc_name->attr.recursive && !sym->attr.automatic && INTEGER_CST_P (DECL_SIZE_UNIT (decl)) && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) /* Put variable length auto array pointers always into stack. */ @@ -656,7 +708,43 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) || sym->attr.pointer || sym->attr.allocatable) && !DECL_ARTIFICIAL (decl)) - TREE_STATIC (decl) = 1; + { + TREE_STATIC (decl) = 1; + + /* Because the size of this variable isn't known until now, we may have + greedily added an initializer to this variable (in build_init_assign) + even though the max-stack-var-size indicates the variable should be + static. Therefore we rip out the automatic initializer here and + replace it with a static one. */ + gfc_symtree *st = gfc_find_symtree (sym->ns->sym_root, sym->name); + gfc_code *prev = NULL; + gfc_code *code = sym->ns->code; + while (code && code->op == EXEC_INIT_ASSIGN) + { + /* Look for an initializer meant for this symbol. */ + if (code->expr1->symtree == st) + { + if (prev) + prev->next = code->next; + else + sym->ns->code = code->next; + + break; + } + + prev = code; + code = code->next; + } + if (code && code->op == EXEC_INIT_ASSIGN) + { + /* Keep the init expression for a static initializer. */ + sym->value = code->expr2; + /* Cleanup the defunct code object, without freeing the init expr. */ + code->expr2 = NULL; + gfc_free_statement (code); + free (code); + } + } /* Handle threadprivate variables. */ if (sym->attr.threadprivate @@ -887,6 +975,10 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) DECL_CONTEXT (token) = sym->ns->proc_name->backend_decl; gfc_module_add_decl (cur_module, token); } + else if (sym->attr.host_assoc + && TREE_CODE (DECL_CONTEXT (current_function_decl)) + != TRANSLATION_UNIT_DECL) + gfc_add_decl_to_parent_function (token); else gfc_add_decl_to_function (token); } @@ -968,9 +1060,9 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) layout_type (type); } - if (TYPE_NAME (type) != NULL_TREE + if (TYPE_NAME (type) != NULL_TREE && as->rank > 0 && GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1) != NULL_TREE - && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1)) == VAR_DECL) + && VAR_P (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1))) { tree gtype = DECL_ORIGINAL_TYPE (TYPE_NAME (type)); @@ -1000,8 +1092,10 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) can be tracked by VTA. Also set DECL_NAMELESS, so that the artificial lbound.N or ubound.N DECL_NAME doesn't end up in debug info. */ - if (lbound && TREE_CODE (lbound) == VAR_DECL - && DECL_ARTIFICIAL (lbound) && DECL_IGNORED_P (lbound)) + if (lbound + && VAR_P (lbound) + && DECL_ARTIFICIAL (lbound) + && DECL_IGNORED_P (lbound)) { if (DECL_NAME (lbound) && strstr (IDENTIFIER_POINTER (DECL_NAME (lbound)), @@ -1009,8 +1103,10 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) DECL_NAMELESS (lbound) = 1; DECL_IGNORED_P (lbound) = 0; } - if (ubound && TREE_CODE (ubound) == VAR_DECL - && DECL_ARTIFICIAL (ubound) && DECL_IGNORED_P (ubound)) + if (ubound + && VAR_P (ubound) + && DECL_ARTIFICIAL (ubound) + && DECL_IGNORED_P (ubound)) { if (DECL_NAME (ubound) && strstr (IDENTIFIER_POINTER (DECL_NAME (ubound)), @@ -1322,7 +1418,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = chainon (list, attr); } - if (sym_attr.omp_declare_target) + if (sym_attr.omp_declare_target_link) + list = tree_cons (get_identifier ("omp declare target link"), + NULL_TREE, list); + else if (sym_attr.omp_declare_target) list = tree_cons (get_identifier ("omp declare target"), NULL_TREE, list); @@ -1464,8 +1563,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) length = gfc_create_string_length (sym); else length = sym->ts.u.cl->backend_decl; - if (TREE_CODE (length) == VAR_DECL - && DECL_FILE_SCOPE_P (length)) + if (VAR_P (length) && DECL_FILE_SCOPE_P (length)) { /* Add the string length to the same context as the symbol. */ if (DECL_CONTEXT (sym->backend_decl) == current_function_decl) @@ -1575,12 +1673,12 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* Create string length decl first so that they can be used in the type declaration. For associate names, the target character length is used. Set 'length' to a constant so that if the - string lenght is a variable, it is not finished a second time. */ + string length is a variable, it is not finished a second time. */ if (sym->ts.type == BT_CHARACTER) { if (sym->attr.associate_var && sym->ts.u.cl->backend_decl - && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL) + && VAR_P (sym->ts.u.cl->backend_decl)) length = gfc_index_zero_node; else length = gfc_create_string_length (sym); @@ -1597,7 +1695,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* Symbols from modules should have their assembler names mangled. This is done here rather than in gfc_finish_var_decl because it is different for string length variables. */ - if (sym->module) + if (sym->module || sym->fn_result_spec) { gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym)); if (sym->attr.use_assoc && !intrinsic_array_parameter) @@ -1689,7 +1787,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) if (TREE_STATIC (decl) && !(sym->attr.use_assoc && !intrinsic_array_parameter) && (sym->attr.save || sym->ns->proc_name->attr.is_main_program - || flag_max_stack_var_size == 0 + || !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE) && (flag_coarray != GFC_FCOARRAY_LIB || !sym->attr.codimension || sym->attr.allocatable)) @@ -2874,8 +2972,7 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) length = gfc_create_string_length (sym); else length = sym->ts.u.cl->backend_decl; - if (TREE_CODE (length) == VAR_DECL - && DECL_CONTEXT (length) == NULL_TREE) + if (VAR_P (length) && DECL_CONTEXT (length) == NULL_TREE) gfc_add_decl_to_function (length); } @@ -3380,12 +3477,6 @@ gfc_build_builtin_function_decls (void) /* STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1; - gfor_fndecl_stop_numeric_f08 = gfc_build_library_function_decl ( - get_identifier (PREFIX("stop_numeric_f08")), - void_type_node, 1, gfc_int4_type_node); - /* STOP doesn't return. */ - TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric_f08) = 1; - gfor_fndecl_stop_string = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("stop_string")), ".R.", void_type_node, 2, pchar_type_node, gfc_int4_type_node); @@ -3498,47 +3589,68 @@ gfc_build_builtin_function_decls (void) = build_pointer_type (build_pointer_type (pchar_type_node)); gfor_fndecl_caf_init = gfc_build_library_function_decl ( - get_identifier (PREFIX("caf_init")), void_type_node, - 2, pint_type, pppchar_type); + get_identifier (PREFIX("caf_init")), void_type_node, + 2, pint_type, pppchar_type); gfor_fndecl_caf_finalize = gfc_build_library_function_decl ( get_identifier (PREFIX("caf_finalize")), void_type_node, 0); gfor_fndecl_caf_this_image = gfc_build_library_function_decl ( - get_identifier (PREFIX("caf_this_image")), integer_type_node, - 1, integer_type_node); + get_identifier (PREFIX("caf_this_image")), integer_type_node, + 1, integer_type_node); gfor_fndecl_caf_num_images = gfc_build_library_function_decl ( - get_identifier (PREFIX("caf_num_images")), integer_type_node, - 2, integer_type_node, integer_type_node); + get_identifier (PREFIX("caf_num_images")), integer_type_node, + 2, integer_type_node, integer_type_node); gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("caf_register")), "...WWW", pvoid_type_node, 6, - size_type_node, integer_type_node, ppvoid_type_node, pint_type, - pchar_type_node, integer_type_node); + get_identifier (PREFIX("caf_register")), "RRWWWWR", void_type_node, 7, + size_type_node, integer_type_node, ppvoid_type_node, pvoid_type_node, + pint_type, pchar_type_node, integer_type_node); gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("caf_deregister")), ".WWW", void_type_node, 4, - ppvoid_type_node, pint_type, pchar_type_node, integer_type_node); + get_identifier (PREFIX("caf_deregister")), "WRWWR", void_type_node, 5, + ppvoid_type_node, integer_type_node, pint_type, pchar_type_node, + integer_type_node); gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("caf_get")), ".R.RRRW", void_type_node, 9, - pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node, + get_identifier (PREFIX("caf_get")), ".R.RRWRRRW", void_type_node, 10, + pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node, pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node, - boolean_type_node); + boolean_type_node, pint_type); gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("caf_send")), ".R.RRRR", void_type_node, 9, - pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node, + get_identifier (PREFIX("caf_send")), ".R.RRRRRRW", void_type_node, 10, + pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node, pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node, - boolean_type_node); + boolean_type_node, pint_type); gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRR", void_type_node, - 13, pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node, - pvoid_type_node, pvoid_type_node, size_type_node, integer_type_node, - pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node, - boolean_type_node); + get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRRRRR", + void_type_node, 14, pvoid_type_node, size_type_node, integer_type_node, + pvoid_type_node, pvoid_type_node, pvoid_type_node, size_type_node, + integer_type_node, pvoid_type_node, pvoid_type_node, integer_type_node, + integer_type_node, boolean_type_node, integer_type_node); + + gfor_fndecl_caf_get_by_ref = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_get_by_ref")), ".RWRRRRRW", void_type_node, + 9, pvoid_type_node, integer_type_node, pvoid_type_node, pvoid_type_node, + integer_type_node, integer_type_node, boolean_type_node, + boolean_type_node, pint_type); + + gfor_fndecl_caf_send_by_ref = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_send_by_ref")), ".RRRRRRRW", void_type_node, + 9, pvoid_type_node, integer_type_node, pvoid_type_node, pvoid_type_node, + integer_type_node, integer_type_node, boolean_type_node, + boolean_type_node, pint_type); + + gfor_fndecl_caf_sendget_by_ref + = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_sendget_by_ref")), ".RR.RRRRRWW", + void_type_node, 11, pvoid_type_node, integer_type_node, + pvoid_type_node, pvoid_type_node, integer_type_node, + pvoid_type_node, integer_type_node, integer_type_node, + boolean_type_node, pint_type, pint_type); gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node, @@ -3566,31 +3678,31 @@ gfc_build_builtin_function_decls (void) TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1; gfor_fndecl_caf_stop_numeric = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("caf_stop_numeric")), ".R.", - void_type_node, 1, gfc_int4_type_node); + get_identifier (PREFIX("caf_stop_numeric")), ".R.", + void_type_node, 1, gfc_int4_type_node); /* CAF's STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_numeric) = 1; gfor_fndecl_caf_stop_str = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("caf_stop_str")), ".R.", - void_type_node, 2, pchar_type_node, gfc_int4_type_node); + get_identifier (PREFIX("caf_stop_str")), ".R.", + void_type_node, 2, pchar_type_node, gfc_int4_type_node); /* CAF's STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_str) = 1; gfor_fndecl_caf_atomic_def = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("caf_atomic_define")), "R..RW", void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node, - pvoid_type_node, pint_type, integer_type_node, integer_type_node); + pvoid_type_node, pint_type, integer_type_node, integer_type_node); gfor_fndecl_caf_atomic_ref = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("caf_atomic_ref")), "R..WW", void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node, - pvoid_type_node, pint_type, integer_type_node, integer_type_node); + pvoid_type_node, pint_type, integer_type_node, integer_type_node); gfor_fndecl_caf_atomic_cas = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("caf_atomic_cas")), "R..WRRW", void_type_node, 9, pvoid_type_node, size_type_node, integer_type_node, - pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type, + pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type, integer_type_node, integer_type_node); gfor_fndecl_caf_atomic_op = gfc_build_library_function_decl_with_spec ( @@ -3624,6 +3736,28 @@ gfc_build_builtin_function_decls (void) void_type_node, 5, pvoid_type_node, size_type_node, integer_type_node, pint_type, pint_type); + gfor_fndecl_caf_fail_image = gfc_build_library_function_decl ( + get_identifier (PREFIX("caf_fail_image")), void_type_node, 0); + /* CAF's FAIL doesn't return. */ + TREE_THIS_VOLATILE (gfor_fndecl_caf_fail_image) = 1; + + gfor_fndecl_caf_failed_images + = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_failed_images")), "WRR", + void_type_node, 3, pvoid_type_node, ppvoid_type_node, + integer_type_node); + + gfor_fndecl_caf_image_status + = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_image_status")), "RR", + integer_type_node, 2, integer_type_node, ppvoid_type_node); + + gfor_fndecl_caf_stopped_images + = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_stopped_images")), "WRR", + void_type_node, 3, pvoid_type_node, ppvoid_type_node, + integer_type_node); + gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("caf_co_broadcast")), "W.WW", void_type_node, 5, pvoid_type_node, integer_type_node, @@ -3642,7 +3776,7 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_co_reduce = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("caf_co_reduce")), "W.R.WW", void_type_node, 8, pvoid_type_node, - build_pointer_type (build_varargs_function_type_list (void_type_node, + build_pointer_type (build_varargs_function_type_list (void_type_node, NULL_TREE)), integer_type_node, integer_type_node, pint_type, pchar_type_node, integer_type_node, integer_type_node); @@ -3651,6 +3785,11 @@ gfc_build_builtin_function_decls (void) get_identifier (PREFIX("caf_co_sum")), "W.WW", void_type_node, 5, pvoid_type_node, integer_type_node, pint_type, pchar_type_node, integer_type_node); + + gfor_fndecl_caf_is_present = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_is_present")), "RRR", + integer_type_node, 3, pvoid_type_node, integer_type_node, + pvoid_type_node); } gfc_build_intrinsic_function_decls (); @@ -3751,7 +3890,7 @@ gfc_trans_vla_one_sizepos (tree *tp, stmtblock_t *body) var = gfc_create_var_np (TREE_TYPE (t), NULL); gfc_add_decl_to_function (var); - gfc_add_modify (body, var, val); + gfc_add_modify (body, var, unshare_expr (val)); if (TREE_CODE (t) == SAVE_EXPR) TREE_OPERAND (t, 0) = var; *tp = var; @@ -4053,7 +4192,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) /* An automatic character length, pointer array result. */ if (proc_sym->ts.type == BT_CHARACTER - && TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL) + && VAR_P (proc_sym->ts.u.cl->backend_decl)) { tmp = NULL; if (proc_sym->ts.deferred) @@ -4106,7 +4245,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp); } - else if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL) + else if (VAR_P (proc_sym->ts.u.cl->backend_decl)) gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block); } else @@ -4372,12 +4511,15 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) tmp = gfc_deallocate_with_status (descriptor, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, true, NULL, - true); + GFC_CAF_COARRAY_ANALYZE); else { gfc_expr *expr = gfc_lval_expr_from_sym (sym); - tmp = gfc_deallocate_scalar_with_status (se.expr, NULL_TREE, - true, expr, sym->ts); + tmp = gfc_deallocate_scalar_with_status (se.expr, + NULL_TREE, + NULL_TREE, + true, expr, + sym->ts); gfc_free_expr (expr); } } @@ -4533,7 +4675,7 @@ gfc_find_module (const char *name) { module_htab_entry *entry = ggc_cleared_alloc<module_htab_entry> (); - entry->name = gfc_get_string (name); + entry->name = gfc_get_string ("%s", name); entry->decls = hash_table<module_decl_hasher>::create_ggc (10); *slot = entry; } @@ -4681,7 +4823,9 @@ gfc_create_module_variable (gfc_symbol * sym) /* Create the variable. */ pushdecl (decl); - gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE); + gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE + || (sym->ns->parent->proc_name->attr.flavor == FL_MODULE + && sym->fn_result_spec)); DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl; rest_of_decl_compilation (decl, 1, 0); gfc_module_add_decl (cur_module, decl); @@ -4773,8 +4917,7 @@ gfc_trans_use_stmts (gfc_namespace * ns) && strcmp (st->n.sym->module, use_stmt->module_name) == 0) { gcc_assert (DECL_EXTERNAL (entry->namespace_decl) - || (TREE_CODE (st->n.sym->backend_decl) - != VAR_DECL)); + || !VAR_P (st->n.sym->backend_decl)); decl = copy_node (st->n.sym->backend_decl); DECL_CONTEXT (decl) = entry->namespace_decl; DECL_EXTERNAL (decl) = 1; @@ -4955,9 +5098,11 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym) static void generate_coarray_sym_init (gfc_symbol *sym) { - tree tmp, size, decl, token; + tree tmp, size, decl, token, desc; bool is_lock_type, is_event_type; int reg_type; + gfc_se se; + symbol_attribute attr; if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension || sym->attr.use_assoc || !sym->attr.referenced @@ -5008,12 +5153,30 @@ generate_coarray_sym_init (gfc_symbol *sym) reg_type = GFC_CAF_EVENT_STATIC; else reg_type = GFC_CAF_COARRAY_STATIC; - tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size, + + /* Compile the symbol attribute. */ + if (sym->ts.type == BT_CLASS) + { + attr = CLASS_DATA (sym)->attr; + /* The pointer attribute is always set on classes, overwrite it with the + class_pointer attribute, which denotes the pointer for classes. */ + attr.pointer = attr.class_pointer; + } + else + attr = sym->attr; + gfc_init_se (&se, NULL); + desc = gfc_conv_scalar_to_descriptor (&se, decl, attr); + gfc_add_block_to_block (&caf_init_block, &se.pre); + + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 7, size, build_int_cst (integer_type_node, reg_type), - token, null_pointer_node, /* token, stat. */ - null_pointer_node, /* errgmsg, errmsg_len. */ - build_int_cst (integer_type_node, 0)); - gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), tmp)); + token, gfc_build_addr_expr (pvoid_type_node, desc), + null_pointer_node, /* stat. */ + null_pointer_node, /* errgmsg. */ + integer_zero_node); /* errmsg_len. */ + gfc_add_expr_to_block (&caf_init_block, tmp); + gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), + gfc_conv_descriptor_data_get (desc))); /* Handle "static" initializer. */ if (sym->value) @@ -5024,6 +5187,13 @@ generate_coarray_sym_init (gfc_symbol *sym) sym->attr.pointer = 0; gfc_add_expr_to_block (&caf_init_block, tmp); } + else if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pointer_comp) + { + tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, decl, sym->as + ? sym->as->rank : 0, + GFC_STRUCTURE_CAF_MODE_IN_COARRAY); + gfc_add_expr_to_block (&caf_init_block, tmp); + } } @@ -5279,9 +5449,19 @@ generate_local_decl (gfc_symbol * sym) } else if (!sym->attr.use_assoc) { - gfc_warning (OPT_Wunused_variable, - "Unused variable %qs declared at %L", - sym->name, &sym->declared_at); + /* Corner case: the symbol may be an entry point. At this point, + it may appear to be an unused variable. Suppress warning. */ + bool enter = false; + gfc_entry_list *el; + + for (el = sym->ns->entries; el; el=el->next) + if (strcmp(sym->name, el->sym->name) == 0) + enter = true; + + if (!enter) + gfc_warning (OPT_Wunused_variable, + "Unused variable %qs declared at %L", + sym->name, &sym->declared_at); if (sym->backend_decl != NULL_TREE) TREE_NO_WARNING(sym->backend_decl) = 1; } @@ -5295,7 +5475,7 @@ generate_local_decl (gfc_symbol * sym) if (sym->attr.dummy && !sym->attr.referenced && sym->ts.type == BT_CHARACTER && sym->ts.u.cl->backend_decl != NULL - && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL) + && VAR_P (sym->ts.u.cl->backend_decl)) { sym->attr.referenced = 1; gfc_get_symbol_decl (sym); @@ -5657,12 +5837,11 @@ create_main_function (tree fndecl) { tree array_type, array, var; vec<constructor_elt, va_gc> *v = NULL; + static const int noptions = 7; - /* Passing a new option to the library requires four modifications: - + add it to the tree_cons list below - + change the array size in the call to build_array_type - + change the first argument to the library call - gfor_fndecl_set_options + /* Passing a new option to the library requires three modifications: + + add it to the tree_cons list below + + change the noptions variable above + modify the library (runtime/compile_options.c)! */ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, @@ -5673,12 +5852,6 @@ create_main_function (tree fndecl) gfc_option.allow_std)); CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, build_int_cst (integer_type_node, pedantic)); - /* TODO: This is the old -fdump-core option, which is unused but - passed due to ABI compatibility; remove when bumping the - library ABI. */ - CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, - build_int_cst (integer_type_node, - 0)); CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, build_int_cst (integer_type_node, flag_backtrace)); CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, @@ -5687,26 +5860,18 @@ create_main_function (tree fndecl) build_int_cst (integer_type_node, (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))); - /* TODO: This is the -frange-check option, which no longer affects - library behavior; when bumping the library ABI this slot can be - reused for something else. As it is the last element in the - array, we can instead leave it out altogether. */ - CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, - build_int_cst (integer_type_node, 0)); CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, build_int_cst (integer_type_node, gfc_option.fpe_summary)); - array_type = build_array_type (integer_type_node, - build_index_type (size_int (8))); + array_type = build_array_type_nelts (integer_type_node, noptions); array = build_constructor (array_type, v); TREE_CONSTANT (array) = 1; TREE_STATIC (array) = 1; /* Create a static variable to hold the jump table. */ var = build_decl (input_location, VAR_DECL, - create_tmp_var_name ("options"), - array_type); + create_tmp_var_name ("options"), array_type); DECL_ARTIFICIAL (var) = 1; DECL_IGNORED_P (var) = 1; TREE_CONSTANT (var) = 1; @@ -5718,7 +5883,7 @@ create_main_function (tree fndecl) tmp = build_call_expr_loc (input_location, gfor_fndecl_set_options, 2, - build_int_cst (integer_type_node, 9), var); + build_int_cst (integer_type_node, noptions), var); gfc_add_expr_to_block (&body, tmp); } @@ -5968,7 +6133,7 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block) continue; if (block) - gfc_error ("Sorry, $!ACC DECLARE at %L is not allowed " + gfc_error ("Sorry, !$ACC DECLARE at %L is not allowed " "in BLOCK construct", &oc->loc); @@ -6049,8 +6214,8 @@ gfc_generate_function_code (gfc_namespace * ns) previous_procedure_symbol = current_procedure_symbol; current_procedure_symbol = sym; - /* Check that the frontend isn't still using this. */ - gcc_assert (sym->tlink == NULL); + /* Initialize sym->tlink so that gfc_trans_deferred_vars does not get + lost or worse. */ sym->tlink = sym; /* Create the declaration for functions with global scope. */ @@ -6219,7 +6384,8 @@ gfc_generate_function_code (gfc_namespace * ns) /* Arrays are not initialized using the default initializer of their elements. Therefore only check if a default initializer is available when the result is scalar. */ - init_exp = rsym->as ? NULL : gfc_default_initializer (&rsym->ts); + init_exp = rsym->as ? NULL + : gfc_generate_initializer (&rsym->ts, true); if (init_exp) { tmp = gfc_trans_structure_assign (result, init_exp, 0); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 18358a4e03..7bced25df4 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1,5 +1,5 @@ /* Expression translation - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -72,6 +72,13 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) desc = gfc_create_var (type, "desc"); DECL_ARTIFICIAL (desc) = 1; + if (CONSTANT_CLASS_P (scalar)) + { + tree tmp; + tmp = gfc_create_var (TREE_TYPE (scalar), "scalar"); + gfc_add_modify (&se->pre, tmp, scalar); + scalar = tmp; + } if (!POINTER_TYPE_P (TREE_TYPE (scalar))) scalar = gfc_build_addr_expr (NULL_TREE, scalar); gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc), @@ -88,6 +95,56 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) } +/* Get the coarray token from the ultimate array or component ref. + Returns a NULL_TREE, when the ref object is not allocatable or pointer. */ + +tree +gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *outerse, gfc_expr *expr) +{ + gfc_symbol *sym = expr->symtree->n.sym; + bool is_coarray = sym->attr.codimension; + gfc_expr *caf_expr = gfc_copy_expr (expr); + gfc_ref *ref = caf_expr->ref, *last_caf_ref = NULL; + + while (ref) + { + if (ref->type == REF_COMPONENT + && (ref->u.c.component->attr.allocatable + || ref->u.c.component->attr.pointer) + && (is_coarray || ref->u.c.component->attr.codimension)) + last_caf_ref = ref; + ref = ref->next; + } + + if (last_caf_ref == NULL) + return NULL_TREE; + + tree comp = last_caf_ref->u.c.component->caf_token, caf; + gfc_se se; + bool comp_ref = !last_caf_ref->u.c.component->attr.dimension; + if (comp == NULL_TREE && comp_ref) + return NULL_TREE; + gfc_init_se (&se, outerse); + gfc_free_ref_list (last_caf_ref->next); + last_caf_ref->next = NULL; + caf_expr->rank = comp_ref ? 0 : last_caf_ref->u.c.component->as->rank; + se.want_pointer = comp_ref; + gfc_conv_expr (&se, caf_expr); + gfc_add_block_to_block (&outerse->pre, &se.pre); + + if (TREE_CODE (se.expr) == COMPONENT_REF && comp_ref) + se.expr = TREE_OPERAND (se.expr, 0); + gfc_free_expr (caf_expr); + + if (comp_ref) + caf = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (comp), se.expr, comp, NULL_TREE); + else + caf = gfc_conv_descriptor_token (se.expr); + return gfc_build_addr_expr (NULL_TREE, caf); +} + + /* This is the seed for an eventual trans-class.c The following parameters should not be used directly since they might @@ -101,6 +158,7 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) #define VTABLE_DEF_INIT_FIELD 3 #define VTABLE_COPY_FIELD 4 #define VTABLE_FINAL_FIELD 5 +#define VTABLE_DEALLOCATE_FIELD 6 tree @@ -141,7 +199,7 @@ gfc_class_vptr_get (tree decl) tree vptr; /* For class arrays decl may be a temporary descriptor handle, the vptr is then available through the saved descriptor. */ - if (TREE_CODE (decl) == VAR_DECL && DECL_LANG_SPECIFIC (decl) + if (VAR_P (decl) && DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl)) decl = GFC_DECL_SAVED_DESCRIPTOR (decl); if (POINTER_TYPE_P (TREE_TYPE (decl))) @@ -160,7 +218,7 @@ gfc_class_len_get (tree decl) tree len; /* For class arrays decl may be a temporary descriptor handle, the len is then available through the saved descriptor. */ - if (TREE_CODE (decl) == VAR_DECL && DECL_LANG_SPECIFIC (decl) + if (VAR_P (decl) && DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl)) decl = GFC_DECL_SAVED_DESCRIPTOR (decl); if (POINTER_TYPE_P (TREE_TYPE (decl))) @@ -182,7 +240,7 @@ gfc_class_len_or_zero_get (tree decl) tree len; /* For class arrays decl may be a temporary descriptor handle, the vptr is then available through the saved descriptor. */ - if (TREE_CODE (decl) == VAR_DECL && DECL_LANG_SPECIFIC (decl) + if (VAR_P (decl) && DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl)) decl = GFC_DECL_SAVED_DESCRIPTOR (decl); if (POINTER_TYPE_P (TREE_TYPE (decl))) @@ -243,6 +301,7 @@ VTAB_GET_FIELD_GEN (extends, VTABLE_EXTENDS_FIELD) 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) /* The size field is returned as an array index type. Therefore treat @@ -293,15 +352,14 @@ gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *e) { gfc_expr *base_expr; - gfc_ref *ref, *class_ref, *tail, *array_ref; + gfc_ref *ref, *class_ref, *tail = NULL, *array_ref; /* Find the last class reference. */ class_ref = NULL; array_ref = NULL; for (ref = e->ref; ref; ref = ref->next) { - if (ref->type == REF_ARRAY - && ref->u.ar.type != AR_ELEMENT) + if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) array_ref = ref; if (ref->type == REF_COMPONENT @@ -310,11 +368,10 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e) /* Component to the right of a part reference with nonzero rank must not have the ALLOCATABLE attribute. If attempts are made to reference such a component reference, an error results - followed by anICE. */ - if (array_ref - && CLASS_DATA (ref->u.c.component)->attr.allocatable) + followed by an ICE. */ + if (array_ref && CLASS_DATA (ref->u.c.component)->attr.allocatable) return NULL; - class_ref = ref; + class_ref = ref; } if (ref->next == NULL) @@ -328,7 +385,7 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e) tail = class_ref->next; class_ref->next = NULL; } - else + else if (e->symtree && e->symtree->n.sym->ts.type == BT_CLASS) { tail = e->ref; e->ref = NULL; @@ -342,7 +399,7 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e) gfc_free_ref_list (class_ref->next); class_ref->next = tail; } - else + else if (e->symtree && e->symtree->n.sym->ts.type == BT_CLASS) { gfc_free_ref_list (e->ref); e->ref = tail; @@ -430,9 +487,16 @@ gfc_get_vptr_from_expr (tree expr) else type = NULL_TREE; } - if (TREE_CODE (tmp) == VAR_DECL) + if (VAR_P (tmp) || TREE_CODE (tmp) == PARM_DECL) break; } + + if (POINTER_TYPE_P (TREE_TYPE (tmp))) + tmp = build_fold_indirect_ref_loc (input_location, tmp); + + if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))) + return gfc_class_vptr_get (tmp); + return NULL_TREE; } @@ -511,7 +575,14 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, if (optional) cond_optional = gfc_conv_expr_present (e->symtree->n.sym); - if (parmse->ss && parmse->ss->info->useflags) + if (parmse->expr && POINTER_TYPE_P (TREE_TYPE (parmse->expr))) + { + /* If there is a ready made pointer to a derived type, use it + rather than evaluating the expression again. */ + tmp = fold_convert (TREE_TYPE (ctree), parmse->expr); + gfc_add_modify (&parmse->pre, ctree, tmp); + } + else if (parmse->ss && parmse->ss->info && parmse->ss->info->useflags) { /* For an array reference in an elemental procedure call we need to retain the ss to provide the scalarized array reference. */ @@ -522,7 +593,6 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, cond_optional, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); gfc_add_modify (&parmse->pre, ctree, tmp); - } else { @@ -792,7 +862,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e, { ctree = gfc_class_len_get (var); /* When the actual arg is a char array, then set the _len component of the - unlimited polymorphic entity, too. */ + unlimited polymorphic entity to the length of the string. */ if (e->ts.type == BT_CHARACTER) { /* Start with parmse->string_length because this seems to be set to a @@ -964,8 +1034,13 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, && e->symtree && e->symtree->n.sym->ts.type == BT_CLASS) { tmp = e->symtree->n.sym->backend_decl; + + if (TREE_CODE (tmp) == FUNCTION_DECL) + tmp = gfc_get_fake_result_decl (e->symtree->n.sym, 0); + if (DECL_LANG_SPECIFIC (tmp) && GFC_DECL_SAVED_DESCRIPTOR (tmp)) tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp); + slen = integer_zero_node; } else @@ -1016,6 +1091,12 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, tmp = integer_zero_node; gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), tmp)); + + /* Return the len component, except in the case of scalarized array + references, where the dynamic type cannot change. */ + if (!elemental && full_array && copyback) + gfc_add_modify (&parmse->post, tmp, + fold_convert (TREE_TYPE (tmp), ctree)); } if (optional) @@ -1166,6 +1247,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) stmtblock_t body; stmtblock_t ifbody; gfc_loopinfo loop; + tree orig_nelems = nelems; /* Needed for bounds check. */ gfc_init_block (&body); tmp = fold_build2_loc (input_location, MINUS_EXPR, @@ -1193,6 +1275,31 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) } vec_safe_push (args, to_ref); + /* Add bounds check. */ + if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc) + { + char *msg; + const char *name = "<<unknown>>"; + tree from_len; + + if (DECL_P (to)) + name = (const char *)(DECL_NAME (to)->identifier.id.str); + + from_len = gfc_conv_descriptor_size (from_data, 1); + tmp = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, from_len, orig_nelems); + msg = xasprintf ("Array bound mismatch for dimension %d " + "of array '%s' (%%ld/%%ld)", + 1, name); + + gfc_trans_runtime_check (true, false, tmp, &body, + &gfc_current_locus, msg, + fold_convert (long_integer_type_node, orig_nelems), + fold_convert (long_integer_type_node, from_len)); + + free (msg); + } + tmp = build_call_vec (fcn_type, fcn, args); /* Build the body of the loop. */ @@ -1357,8 +1464,13 @@ gfc_trans_class_init_assign (gfc_code *code) rhs->rank = 0; if (code->expr1->ts.type == BT_CLASS - && CLASS_DATA (code->expr1)->attr.dimension) - tmp = gfc_trans_class_array_init_assign (rhs, lhs, code->expr1); + && CLASS_DATA (code->expr1)->attr.dimension) + { + gfc_array_spec *tmparr = gfc_get_array_spec (); + *tmparr = *CLASS_DATA (code->expr1)->as; + gfc_add_full_array_ref (lhs, tmparr); + tmp = gfc_trans_class_array_init_assign (rhs, lhs, code->expr1); + } else { sz = gfc_copy_expr (code->expr1); @@ -1403,114 +1515,6 @@ gfc_trans_class_init_assign (gfc_code *code) } -/* Translate an assignment to a CLASS object - (pointer or ordinary assignment). */ - -tree -gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op) -{ - stmtblock_t block; - tree tmp; - gfc_expr *lhs; - gfc_expr *rhs; - gfc_ref *ref; - - gfc_start_block (&block); - - ref = expr1->ref; - while (ref && ref->next) - ref = ref->next; - - /* Class valued proc_pointer assignments do not need any further - preparation. */ - if (ref && ref->type == REF_COMPONENT - && ref->u.c.component->attr.proc_pointer - && expr2->expr_type == EXPR_VARIABLE - && expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE - && op == EXEC_POINTER_ASSIGN) - goto assign; - - if (expr2->ts.type != BT_CLASS) - { - /* Insert an additional assignment which sets the '_vptr' field. */ - gfc_symbol *vtab = NULL; - gfc_symtree *st; - - lhs = gfc_copy_expr (expr1); - gfc_add_vptr_component (lhs); - - if (UNLIMITED_POLY (expr1) - && expr2->expr_type == EXPR_NULL && expr2->ts.type == BT_UNKNOWN) - { - rhs = gfc_get_null_expr (&expr2->where); - goto assign_vptr; - } - - if (expr2->expr_type == EXPR_NULL) - vtab = gfc_find_vtab (&expr1->ts); - else - vtab = gfc_find_vtab (&expr2->ts); - gcc_assert (vtab); - - rhs = gfc_get_expr (); - rhs->expr_type = EXPR_VARIABLE; - gfc_find_sym_tree (vtab->name, vtab->ns, 1, &st); - rhs->symtree = st; - rhs->ts = vtab->ts; -assign_vptr: - tmp = gfc_trans_pointer_assignment (lhs, rhs); - gfc_add_expr_to_block (&block, tmp); - - gfc_free_expr (lhs); - gfc_free_expr (rhs); - } - else if (expr1->ts.type == BT_DERIVED && UNLIMITED_POLY (expr2)) - { - /* F2003:C717 only sequence and bind-C types can come here. */ - gcc_assert (expr1->ts.u.derived->attr.sequence - || expr1->ts.u.derived->attr.is_bind_c); - gfc_add_data_component (expr2); - goto assign; - } - else if (CLASS_DATA (expr2)->attr.dimension && expr2->expr_type != EXPR_FUNCTION) - { - /* Insert an additional assignment which sets the '_vptr' field. */ - lhs = gfc_copy_expr (expr1); - gfc_add_vptr_component (lhs); - - rhs = gfc_copy_expr (expr2); - gfc_add_vptr_component (rhs); - - tmp = gfc_trans_pointer_assignment (lhs, rhs); - gfc_add_expr_to_block (&block, tmp); - - gfc_free_expr (lhs); - gfc_free_expr (rhs); - } - - /* Do the actual CLASS assignment. */ - if (expr2->ts.type == BT_CLASS - && !CLASS_DATA (expr2)->attr.dimension) - op = EXEC_ASSIGN; - else if (expr2->expr_type != EXPR_FUNCTION || expr2->ts.type != BT_CLASS - || !CLASS_DATA (expr2)->attr.dimension) - gfc_add_data_component (expr1); - -assign: - - if (op == EXEC_ASSIGN) - tmp = gfc_trans_assignment (expr1, expr2, false, true); - else if (op == EXEC_POINTER_ASSIGN) - tmp = gfc_trans_pointer_assignment (expr1, expr2); - else - gcc_unreachable(); - - gfc_add_expr_to_block (&block, tmp); - - return gfc_finish_block (&block); -} - - /* End of prototype trans-class.c */ @@ -1813,69 +1817,54 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr) { tree caf_decl; bool found = false; - gfc_ref *ref, *comp_ref = NULL; + gfc_ref *ref; gcc_assert (expr && expr->expr_type == EXPR_VARIABLE); /* Not-implemented diagnostic. */ + if (expr->symtree->n.sym->ts.type == BT_CLASS + && UNLIMITED_POLY (expr->symtree->n.sym) + && CLASS_DATA (expr->symtree->n.sym)->attr.codimension) + gfc_error ("Sorry, coindexed access to an unlimited polymorphic object at " + "%L is not supported", &expr->where); + for (ref = expr->ref; ref; ref = ref->next) if (ref->type == REF_COMPONENT) { - comp_ref = ref; - if ((ref->u.c.component->ts.type == BT_CLASS - && !CLASS_DATA (ref->u.c.component)->attr.codimension - && (CLASS_DATA (ref->u.c.component)->attr.pointer - || CLASS_DATA (ref->u.c.component)->attr.allocatable)) - || (ref->u.c.component->ts.type != BT_CLASS - && !ref->u.c.component->attr.codimension - && (ref->u.c.component->attr.pointer - || ref->u.c.component->attr.allocatable))) - gfc_error ("Sorry, coindexed access to a pointer or allocatable " - "component of the coindexed coarray at %L is not yet " - "supported", &expr->where); + if (ref->u.c.component->ts.type == BT_CLASS + && UNLIMITED_POLY (ref->u.c.component) + && CLASS_DATA (ref->u.c.component)->attr.codimension) + gfc_error ("Sorry, coindexed access to an unlimited polymorphic " + "component at %L is not supported", &expr->where); } - if ((!comp_ref - && ((expr->symtree->n.sym->ts.type == BT_CLASS - && CLASS_DATA (expr->symtree->n.sym)->attr.alloc_comp) - || (expr->symtree->n.sym->ts.type == BT_DERIVED - && expr->symtree->n.sym->ts.u.derived->attr.alloc_comp))) - || (comp_ref - && ((comp_ref->u.c.component->ts.type == BT_CLASS - && CLASS_DATA (comp_ref->u.c.component)->attr.alloc_comp) - || (comp_ref->u.c.component->ts.type == BT_DERIVED - && comp_ref->u.c.component->ts.u.derived->attr.alloc_comp)))) - gfc_error ("Sorry, coindexed coarray at %L with allocatable component is " - "not yet supported", &expr->where); - - if (expr->rank) - { - /* Without the new array descriptor, access like "caf[i]%a(:)%b" is in - general not possible as the required stride multiplier might be not - a multiple of c_sizeof(b). In case of noncoindexed access, the - scalarizer often takes care of it - for coarrays, it always fails. */ - for (ref = expr->ref; ref; ref = ref->next) - if (ref->type == REF_COMPONENT - && ((ref->u.c.component->ts.type == BT_CLASS - && CLASS_DATA (ref->u.c.component)->attr.codimension) - || (ref->u.c.component->ts.type != BT_CLASS - && ref->u.c.component->attr.codimension))) - break; - if (ref == NULL) - ref = expr->ref; - for ( ; ref; ref = ref->next) - if (ref->type == REF_ARRAY && ref->u.ar.dimen) - break; - for ( ; ref; ref = ref->next) - if (ref->type == REF_COMPONENT) - gfc_error ("Sorry, coindexed access at %L to a scalar component " - "with an array partref is not yet supported", - &expr->where); - } - caf_decl = expr->symtree->n.sym->backend_decl; - gcc_assert (caf_decl); + /* Make sure the backend_decl is present before accessing it. */ + caf_decl = expr->symtree->n.sym->backend_decl == NULL_TREE + ? gfc_get_symbol_decl (expr->symtree->n.sym) + : expr->symtree->n.sym->backend_decl; + if (expr->symtree->n.sym->ts.type == BT_CLASS) - caf_decl = gfc_class_data_get (caf_decl); + { + if (expr->ref && expr->ref->type == REF_ARRAY) + { + caf_decl = gfc_class_data_get (caf_decl); + if (CLASS_DATA (expr->symtree->n.sym)->attr.codimension) + return caf_decl; + } + for (ref = expr->ref; ref; ref = ref->next) + { + if (ref->type == REF_COMPONENT + && strcmp (ref->u.c.component->name, "_data") != 0) + { + caf_decl = gfc_class_data_get (caf_decl); + if (CLASS_DATA (expr->symtree->n.sym)->attr.codimension) + return caf_decl; + break; + } + else if (ref->type == REF_ARRAY && ref->u.ar.dimen) + break; + } + } if (expr->symtree->n.sym->attr.codimension) return caf_decl; @@ -1893,7 +1882,14 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr) TREE_TYPE (comp->backend_decl), caf_decl, comp->backend_decl, NULL_TREE); if (comp->ts.type == BT_CLASS) - caf_decl = gfc_class_data_get (caf_decl); + { + caf_decl = gfc_class_data_get (caf_decl); + if (CLASS_DATA (comp)->attr.codimension) + { + found = true; + break; + } + } if (comp->attr.codimension) { found = true; @@ -1908,8 +1904,8 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr) /* Obtain the Coarray token - and optionally also the offset. */ void -gfc_get_caf_token_offset (tree *token, tree *offset, tree caf_decl, tree se_expr, - gfc_expr *expr) +gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl, + tree se_expr, gfc_expr *expr) { tree tmp; @@ -1964,7 +1960,47 @@ gfc_get_caf_token_offset (tree *token, tree *offset, tree caf_decl, tree se_expr *offset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, *offset, fold_convert (gfc_array_index_type, tmp)); - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl))) + if (expr->symtree->n.sym->ts.type == BT_DERIVED + && expr->symtree->n.sym->attr.codimension + && expr->symtree->n.sym->ts.u.derived->attr.alloc_comp) + { + gfc_expr *base_expr = gfc_copy_expr (expr); + gfc_ref *ref = base_expr->ref; + gfc_se base_se; + + // Iterate through the refs until the last one. + while (ref->next) + ref = ref->next; + + if (ref->type == REF_ARRAY + && ref->u.ar.type != AR_FULL) + { + const int ranksum = ref->u.ar.dimen + ref->u.ar.codimen; + int i; + for (i = 0; i < ranksum; ++i) + { + ref->u.ar.start[i] = NULL; + ref->u.ar.end[i] = NULL; + } + ref->u.ar.type = AR_FULL; + } + gfc_init_se (&base_se, NULL); + if (gfc_caf_attr (base_expr).dimension) + { + gfc_conv_expr_descriptor (&base_se, base_expr); + tmp = gfc_conv_descriptor_data_get (base_se.expr); + } + else + { + gfc_conv_expr (&base_se, base_expr); + tmp = base_se.expr; + } + + gfc_free_expr (base_expr); + gfc_add_block_to_block (&se->pre, &base_se.pre); + gfc_add_block_to_block (&se->post, &base_se.post); + } + else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl))) tmp = gfc_conv_descriptor_data_get (caf_decl); else { @@ -1995,6 +2031,12 @@ gfc_caf_get_image_index (stmtblock_t *block, gfc_expr *e, tree desc) break; gcc_assert (ref != NULL); + if (ref->u.ar.dimen_type[ref->u.ar.dimen] == DIMEN_THIS_IMAGE) + { + return build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1, + integer_zero_node); + } + img_idx = integer_zero_node; extent = integer_one_node; if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) @@ -2102,6 +2144,7 @@ flatten_array_ctors_without_strlen (gfc_expr* e) } /* Otherwise, fall through to handle constructor elements. */ + gcc_fallthrough (); case EXPR_STRUCTURE: for (c = gfc_constructor_first (e->value.constructor); c; c = gfc_constructor_next (c)) @@ -2127,9 +2170,7 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock) gfc_init_se (&se, NULL); - if (!cl->length - && cl->backend_decl - && TREE_CODE (cl->backend_decl) == VAR_DECL) + if (!cl->length && cl->backend_decl && VAR_P (cl->backend_decl)) return; /* If cl->length is NULL, use gfc_conv_expr to obtain the string length but @@ -2236,7 +2277,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, msg = xasprintf ("Substring out of bounds: lower bound (%%ld) of '%s' " "is less than one", name); else - msg = xasprintf ("Substring out of bounds: lower bound (%%ld)" + msg = xasprintf ("Substring out of bounds: lower bound (%%ld) " "is less than one"); gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, fold_convert (long_integer_type_node, @@ -2319,7 +2360,7 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref) On the other hand, if the context is a UNION or a MAP (a RECORD_TYPE within a UNION_TYPE) always use the given FIELD_DECL. */ - if (context != TREE_TYPE (decl) + if (context != TREE_TYPE (decl) && !( TREE_CODE (TREE_TYPE (field)) == UNION_TYPE /* Field is union */ || TREE_CODE (context) == UNION_TYPE)) /* Field is map */ { @@ -2503,8 +2544,10 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) if (se_expr) se->expr = se_expr; - /* Procedure actual arguments. */ - else if (sym->attr.flavor == FL_PROCEDURE + /* Procedure actual arguments. Look out for temporary variables + with the same attributes as function values. */ + else if (!sym->attr.temporary + && sym->attr.flavor == FL_PROCEDURE && se->expr != current_function_decl) { if (!sym->attr.dummy && !sym->attr.proc_pointer) @@ -2826,9 +2869,9 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) return 0; m = wrhs.to_shwi (); - /* There's no ABS for HOST_WIDE_INT, so here we go. It also takes care - of the asymmetric range of the integer type. */ - n = (unsigned HOST_WIDE_INT) (m < 0 ? -m : m); + /* Use the wide_int's routine to reliably get the absolute value on all + platforms. Then convert it to a HOST_WIDE_INT like above. */ + n = wi::abs (wrhs).to_shwi (); type = TREE_TYPE (lhs); sgn = tree_int_cst_sgn (rhs); @@ -3631,7 +3674,7 @@ conv_base_obj_fcn_val (gfc_se * se, tree base_object, gfc_expr * expr) gfc_ref *ref; tree var; - if (TREE_CODE (base_object) != VAR_DECL) + if (!VAR_P (base_object)) { var = gfc_create_var (TREE_TYPE (base_object), NULL); gfc_add_modify (&se->pre, var, base_object); @@ -3902,6 +3945,10 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping, if (sym->attr.flavor == FL_PROCEDURE) value = se->expr; + /* If the argument is a pass-by-value scalar, use the value as is. */ + else if (!sym->attr.dimension && sym->attr.value) + value = se->expr; + /* If the argument is either a string or a pointer to a string, convert it to a boundless character type. */ else if (!sym->attr.dimension && sym->ts.type == BT_CHARACTER) @@ -4074,6 +4121,16 @@ gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping *mapping) new_expr = gfc_copy_expr (arg1->ts.u.cl->length); break; + case GFC_ISYM_LEN_TRIM: + new_expr = gfc_copy_expr (arg1); + gfc_apply_interface_mapping_to_expr (mapping, new_expr); + + if (!new_expr) + return false; + + gfc_replace_expr (arg1, new_expr); + return true; + case GFC_ISYM_SIZE: if (!sym->as || sym->as->rank == 0) return false; @@ -4633,10 +4690,11 @@ expr_may_alias_variables (gfc_expr *e, bool array_may_alias) { gfc_symbol *proc_ifc = gfc_get_proc_ifc_for_expr (e); - if ((proc_ifc->result->ts.type == BT_CLASS - && proc_ifc->result->ts.u.derived->attr.is_class - && CLASS_DATA (proc_ifc->result)->attr.class_pointer) - || proc_ifc->result->attr.pointer) + if (proc_ifc->result != NULL + && ((proc_ifc->result->ts.type == BT_CLASS + && proc_ifc->result->ts.u.derived->attr.is_class + && CLASS_DATA (proc_ifc->result)->attr.class_pointer) + || proc_ifc->result->attr.pointer)) return true; else return false; @@ -5165,7 +5223,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ptr = gfc_class_data_get (ptr); tmp = gfc_deallocate_scalar_with_status (ptr, NULL_TREE, - true, e, e->ts); + NULL_TREE, true, + e, e->ts); gfc_add_expr_to_block (&block, tmp); tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, ptr, @@ -5274,7 +5333,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = gfc_deallocate_with_status (ptr, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, true, e, - false); + GFC_CAF_COARRAY_NOCOARRAY); gfc_add_expr_to_block (&block, tmp); tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, ptr, @@ -5397,7 +5456,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { tmp = build_fold_indirect_ref_loc (input_location, parmse.expr); - tmp = gfc_trans_dealloc_allocated (tmp, false, e); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + tmp = gfc_conv_descriptor_data_get (tmp); + tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, + NULL_TREE, NULL_TREE, true, + e, + GFC_CAF_COARRAY_NOCOARRAY); if (fsym->attr.optional && e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional) @@ -5509,7 +5573,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { tree local_tmp; local_tmp = gfc_evaluate_now (tmp, &se->pre); - local_tmp = gfc_copy_alloc_comp (e->ts.u.derived, local_tmp, tmp, parm_rank); + local_tmp = gfc_copy_alloc_comp (e->ts.u.derived, local_tmp, tmp, + parm_rank, 0); gfc_add_expr_to_block (&se->post, local_tmp); } @@ -5525,7 +5590,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank); - gfc_add_expr_to_block (&se->post, tmp); + gfc_prepend_expr_to_block (&post, tmp); } /* Add argument checking of passing an unallocated/NULL actual to @@ -5637,8 +5702,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else { tmp = parmse.string_length; - if (TREE_CODE (tmp) != VAR_DECL - && TREE_CODE (tmp) != COMPONENT_REF) + if (!VAR_P (tmp) && TREE_CODE (tmp) != COMPONENT_REF) tmp = gfc_evaluate_now (parmse.string_length, &se->pre); parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp); } @@ -5767,8 +5831,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (comp) ts = comp->ts; + else if (sym->ts.type == BT_CLASS) + ts = CLASS_DATA (sym)->ts; else - ts = sym->ts; + ts = sym->ts; if (ts.type == BT_CHARACTER && sym->attr.is_bind_c) se->string_length = build_int_cst (gfc_charlen_type_node, 1); @@ -5837,7 +5903,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))))) se->expr = build_fold_indirect_ref_loc (input_location, - se->expr); + se->expr); /* If the lhs of an assignment x = f(..) is allocatable and f2003 is allowed, we must do the automatic reallocation. @@ -5941,6 +6007,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, type = gfc_get_character_type (ts.kind, ts.u.cl); type = build_pointer_type (type); + /* Emit a DECL_EXPR for the VLA type. */ + tmp = TREE_TYPE (type); + if (TYPE_SIZE (tmp) + && TREE_CODE (TYPE_SIZE (tmp)) != INTEGER_CST) + { + tmp = build_decl (input_location, TYPE_DECL, NULL_TREE, tmp); + DECL_ARTIFICIAL (tmp) = 1; + DECL_IGNORED_P (tmp) = 1; + tmp = fold_build1_loc (input_location, DECL_EXPR, + TREE_TYPE (tmp), tmp); + gfc_add_expr_to_block (&se->pre, tmp); + } + /* Return an address to a char[0:len-1]* temporary for character pointers. */ if ((!comp && (sym->attr.pointer || sym->attr.allocatable)) @@ -5979,7 +6058,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (ts.type == BT_CHARACTER && ts.deferred) { tmp = len; - if (TREE_CODE (tmp) != VAR_DECL) + if (!VAR_P (tmp)) tmp = gfc_evaluate_now (len, &se->pre); TREE_STATIC (tmp) = 1; gfc_add_modify (&se->pre, tmp, @@ -6123,19 +6202,41 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, } } + /* Associate the rhs class object's meta-data with the result, when the + result is a temporary. */ + if (args && args->expr && args->expr->ts.type == BT_CLASS + && sym->ts.type == BT_CLASS && result != NULL_TREE && DECL_P (result) + && !GFC_CLASS_TYPE_P (TREE_TYPE (result))) + { + gfc_se parmse; + gfc_expr *class_expr = gfc_find_and_cut_at_last_class_ref (args->expr); + + gfc_init_se (&parmse, NULL); + parmse.data_not_needed = 1; + gfc_conv_expr (&parmse, class_expr); + if (!DECL_LANG_SPECIFIC (result)) + gfc_allocate_lang_decl (result); + GFC_DECL_SAVED_DESCRIPTOR (result) = parmse.expr; + gfc_free_expr (class_expr); + gcc_assert (parmse.pre.head == NULL_TREE + && parmse.post.head == NULL_TREE); + } + /* Follow the function call with the argument post block. */ if (byref) { gfc_add_block_to_block (&se->pre, &post); /* Transformational functions of derived types with allocatable - components must have the result allocatable components copied. */ + components must have the result allocatable components copied when the + argument is actually given. */ arg = expr->value.function.actual; if (result && arg && expr->rank - && expr->value.function.isym - && expr->value.function.isym->transformational - && arg->expr->ts.type == BT_DERIVED - && arg->expr->ts.u.derived->attr.alloc_comp) + && expr->value.function.isym + && expr->value.function.isym->transformational + && arg->expr + && arg->expr->ts.type == BT_DERIVED + && arg->expr->ts.u.derived->attr.alloc_comp) { tree tmp2; /* Copy the allocatable components. We have to use a @@ -6143,7 +6244,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, from being corrupted. */ tmp2 = gfc_evaluate_now (result, &se->pre); tmp = gfc_copy_alloc_comp (arg->expr->ts.u.derived, - result, tmp2, expr->rank); + result, tmp2, expr->rank, 0); gfc_add_expr_to_block (&se->pre, tmp); tmp = gfc_copy_allocatable_data (result, tmp2, TREE_TYPE(tmp2), expr->rank); @@ -6153,7 +6254,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = gfc_conv_descriptor_data_get (tmp2); tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, true, - NULL, false); + NULL, GFC_CAF_COARRAY_NOCOARRAY); gfc_add_expr_to_block (&se->pre, tmp); } } @@ -6356,33 +6457,19 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, return; } + /* The string copy algorithm below generates code like + + if (dlen > 0) { + memmove (dest, src, min(dlen, slen)); + if (slen < dlen) + memset(&dest[slen], ' ', dlen - slen); + } + */ + /* Do nothing if the destination length is zero. */ cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, dlen, build_int_cst (size_type_node, 0)); - /* The following code was previously in _gfortran_copy_string: - - // The two strings may overlap so we use memmove. - void - copy_string (GFC_INTEGER_4 destlen, char * dest, - GFC_INTEGER_4 srclen, const char * src) - { - if (srclen >= destlen) - { - // This will truncate if too long. - memmove (dest, src, destlen); - } - else - { - memmove (dest, src, srclen); - // Pad with spaces. - memset (&dest[srclen], ' ', destlen - srclen); - } - } - - We're now doing it here for better optimization, but the logic - is the same. */ - /* For non-default character kinds, we have to multiply the string length by the base type size. */ chartype = gfc_get_char_type (dkind); @@ -6405,31 +6492,42 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, else src = gfc_build_addr_expr (pvoid_type_node, src); - /* Truncate string if source is too long. */ - cond2 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, slen, - dlen); + /* First do the memmove. */ + tmp2 = fold_build2_loc (input_location, MIN_EXPR, TREE_TYPE (dlen), dlen, + slen); tmp2 = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_MEMMOVE), - 3, dest, src, dlen); + 3, dest, src, tmp2); + stmtblock_t tmpblock2; + gfc_init_block (&tmpblock2); + gfc_add_expr_to_block (&tmpblock2, tmp2); - /* Else copy and pad with spaces. */ - tmp3 = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MEMMOVE), - 3, dest, src, slen); + /* If the destination is longer, fill the end with spaces. */ + cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, slen, + dlen); + + /* Wstringop-overflow appears at -O3 even though this warning is not + explicitly available in fortran nor can it be switched off. If the + source length is a constant, its negative appears as a very large + postive number and triggers the warning in BUILTIN_MEMSET. Fixing + the result of the MINUS_EXPR suppresses this spurious warning. */ + tmp = fold_build2_loc (input_location, MINUS_EXPR, + TREE_TYPE(dlen), dlen, slen); + if (slength && TREE_CONSTANT (slength)) + tmp = gfc_evaluate_now (tmp, block); tmp4 = fold_build_pointer_plus_loc (input_location, dest, slen); - tmp4 = fill_with_spaces (tmp4, chartype, - fold_build2_loc (input_location, MINUS_EXPR, - TREE_TYPE(dlen), dlen, slen)); + tmp4 = fill_with_spaces (tmp4, chartype, tmp); gfc_init_block (&tempblock); - gfc_add_expr_to_block (&tempblock, tmp3); gfc_add_expr_to_block (&tempblock, tmp4); tmp3 = gfc_finish_block (&tempblock); /* The whole copy_string function is there. */ tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2, - tmp2, tmp3); + tmp3, build_empty_stmt (input_location)); + gfc_add_expr_to_block (&tmpblock2, tmp); + tmp = gfc_finish_block (&tmpblock2); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); @@ -6868,16 +6966,18 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm, /* Deal with arrays of derived types with allocatable components. */ if (gfc_bt_struct (cm->ts.type) && cm->ts.u.derived->attr.alloc_comp) + // TODO: Fix caf_mode tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr, dest, - cm->as->rank); + cm->as->rank, 0); else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_DERIVED && CLASS_DATA(cm)->attr.allocatable) { if (cm->ts.u.derived->attr.alloc_comp) + // TODO: Fix caf_mode tmp = gfc_copy_alloc_comp (expr->ts.u.derived, se.expr, dest, - expr->rank); + expr->rank, 0); else { tmp = TREE_TYPE (dest); @@ -7257,7 +7357,30 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, fold_convert (TREE_TYPE (tmp), se.expr)); gfc_add_block_to_block (&block, &se.post); } - else if (gfc_bt_struct (expr->ts.type) && expr->ts.f90_type != BT_VOID) + else if (expr->ts.type == BT_UNION) + { + tree tmp; + gfc_constructor *c = gfc_constructor_first (expr->value.constructor); + /* We mark that the entire union should be initialized with a contrived + EXPR_NULL expression at the beginning. */ + if (c != NULL && c->n.component == NULL + && c->expr != NULL && c->expr->expr_type == EXPR_NULL) + { + tmp = build2_loc (input_location, MODIFY_EXPR, void_type_node, + dest, build_constructor (TREE_TYPE (dest), NULL)); + gfc_add_expr_to_block (&block, tmp); + c = gfc_constructor_next (c); + } + /* The following constructor expression, if any, represents a specific + map intializer, as given by the user. */ + if (c != NULL && c->expr != NULL) + { + gcc_assert (expr->expr_type == EXPR_STRUCTURE); + tmp = gfc_trans_structure_assign (dest, expr, expr->symtree != NULL); + gfc_add_expr_to_block (&block, tmp); + } + } + else if (expr->ts.type == BT_DERIVED && expr->ts.f90_type != BT_VOID) { if (expr->expr_type != EXPR_STRUCTURE) { @@ -7280,8 +7403,9 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, if (cm->ts.u.derived->attr.alloc_comp && expr->expr_type != EXPR_NULL) { + // TODO: Fix caf_mode tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr, - dest, expr->rank); + dest, expr->rank, 0); gfc_add_expr_to_block (&block, tmp); if (dealloc != NULL_TREE) gfc_add_expr_to_block (&block, dealloc); @@ -7347,13 +7471,14 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, /* Assign a derived type constructor to a variable. */ tree -gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) +gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray) { gfc_constructor *c; gfc_component *cm; stmtblock_t block; tree field; tree tmp; + gfc_se se; gfc_start_block (&block); cm = expr->ts.u.derived->components; @@ -7362,7 +7487,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) && (expr->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR || expr->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR)) { - gfc_se se, lse; + gfc_se lse; gfc_init_se (&se, NULL); gfc_init_se (&lse, NULL); @@ -7374,6 +7499,9 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) return gfc_finish_block (&block); } + if (coarray) + gfc_init_se (&se, NULL); + for (c = gfc_constructor_first (expr->value.constructor); c; c = gfc_constructor_next (c), cm = cm->next) { @@ -7381,6 +7509,65 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) if (!c->expr && !cm->attr.allocatable) continue; + /* Register the component with the caf-lib before it is initialized. + Register only allocatable components, that are not coarray'ed + components (%comp[*]). Only register when the constructor is not the + null-expression. */ + if (coarray && !cm->attr.codimension + && (cm->attr.allocatable || cm->attr.pointer) + && (!c->expr || c->expr->expr_type == EXPR_NULL)) + { + tree token, desc, size; + bool is_array = cm->ts.type == BT_CLASS + ? CLASS_DATA (cm)->attr.dimension : cm->attr.dimension; + + field = cm->backend_decl; + field = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), dest, field, NULL_TREE); + if (cm->ts.type == BT_CLASS) + field = gfc_class_data_get (field); + + token = is_array ? gfc_conv_descriptor_token (field) + : fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (cm->caf_token), dest, + cm->caf_token, NULL_TREE); + + if (is_array) + { + /* The _caf_register routine looks at the rank of the array + descriptor to decide whether the data registered is an array + or not. */ + int rank = cm->ts.type == BT_CLASS ? CLASS_DATA (cm)->as->rank + : cm->as->rank; + /* When the rank is not known just set a positive rank, which + suffices to recognize the data as array. */ + if (rank < 0) + rank = 1; + size = integer_zero_node; + desc = field; + gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc), + build_int_cst (gfc_array_index_type, rank)); + } + else + { + desc = gfc_conv_scalar_to_descriptor (&se, field, + cm->ts.type == BT_CLASS + ? CLASS_DATA (cm)->attr + : cm->attr); + size = TYPE_SIZE_UNIT (TREE_TYPE (field)); + } + gfc_add_block_to_block (&block, &se.pre); + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, + 7, size, build_int_cst ( + integer_type_node, + GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY), + gfc_build_addr_expr (pvoid_type_node, + token), + gfc_build_addr_expr (NULL_TREE, desc), + null_pointer_node, null_pointer_node, + integer_zero_node); + gfc_add_expr_to_block (&block, tmp); + } field = cm->backend_decl; tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), dest, field, NULL_TREE); @@ -7399,6 +7586,43 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) return gfc_finish_block (&block); } +void +gfc_conv_union_initializer (vec<constructor_elt, va_gc> *v, + gfc_component *un, gfc_expr *init) +{ + gfc_constructor *ctor; + + if (un->ts.type != BT_UNION || un == NULL || init == NULL) + return; + + ctor = gfc_constructor_first (init->value.constructor); + + if (ctor == NULL || ctor->expr == NULL) + return; + + gcc_assert (init->expr_type == EXPR_STRUCTURE); + + /* If we have an 'initialize all' constructor, do it first. */ + if (ctor->expr->expr_type == EXPR_NULL) + { + tree union_type = TREE_TYPE (un->backend_decl); + tree val = build_constructor (union_type, NULL); + CONSTRUCTOR_APPEND_ELT (v, un->backend_decl, val); + ctor = gfc_constructor_next (ctor); + } + + /* Add the map initializer on top. */ + if (ctor != NULL && ctor->expr != NULL) + { + gcc_assert (ctor->expr->expr_type == EXPR_STRUCTURE); + tree val = gfc_conv_initializer (ctor->expr, &un->ts, + TREE_TYPE (un->backend_decl), + un->attr.dimension, un->attr.pointer, + un->attr.proc_pointer); + CONSTRUCTOR_APPEND_ELT (v, un->backend_decl, val); + } +} + /* Build an expression for a constructor. If init is nonzero then this is part of a static variable initializer. */ @@ -7422,29 +7646,12 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) se->expr = gfc_create_var (type, expr->ts.u.derived->name); /* The symtree in expr is NULL, if the code to generate is for initializing the static members only. */ - tmp = gfc_trans_structure_assign (se->expr, expr, expr->symtree != NULL); + tmp = gfc_trans_structure_assign (se->expr, expr, expr->symtree != NULL, + se->want_coarray); gfc_add_expr_to_block (&se->pre, tmp); return; } - /* Though unions appear to have multiple map components, they must only - have a single initializer since each map overlaps. TODO: squash map - constructors? */ - if (expr->ts.type == BT_UNION) - { - c = gfc_constructor_first (expr->value.constructor); - cm = c->n.component; - val = gfc_conv_initializer (c->expr, &expr->ts, - TREE_TYPE (cm->backend_decl), - cm->attr.dimension, cm->attr.pointer, - cm->attr.proc_pointer); - val = unshare_expr_without_location (val); - - /* Append it to the constructor list. */ - CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val); - goto finish; - } - cm = expr->ts.u.derived->components; for (c = gfc_constructor_first (expr->value.constructor); @@ -7479,6 +7686,8 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, fold_convert (TREE_TYPE (cm->backend_decl), integer_zero_node)); + else if (cm->ts.type == BT_UNION) + gfc_conv_union_initializer (v, cm, c->expr); else { val = gfc_conv_initializer (c->expr, &cm->ts, @@ -7491,7 +7700,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val); } } -finish: + se->expr = build_constructor (type, v); if (init) TREE_CONSTANT (se->expr) = 1; @@ -7745,6 +7954,247 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) } +/* Get the _len component for an unlimited polymorphic expression. */ + +static tree +trans_get_upoly_len (stmtblock_t *block, gfc_expr *expr) +{ + gfc_se se; + gfc_ref *ref = expr->ref; + + gfc_init_se (&se, NULL); + while (ref && ref->next) + ref = ref->next; + gfc_add_len_component (expr); + gfc_conv_expr (&se, expr); + gfc_add_block_to_block (block, &se.pre); + gcc_assert (se.post.head == NULL_TREE); + if (ref) + { + gfc_free_ref_list (ref->next); + ref->next = NULL; + } + else + { + gfc_free_ref_list (expr->ref); + expr->ref = NULL; + } + return se.expr; +} + + +/* Assign _vptr and _len components as appropriate. BLOCK should be a + statement-list outside of the scalarizer-loop. When code is generated, that + depends on the scalarized expression, it is added to RSE.PRE. + Returns le's _vptr tree and when set the len expressions in to_lenp and + from_lenp to form a le%_vptr%_copy (re, le, [from_lenp, to_lenp]) + expression. */ + +static tree +trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le, + gfc_expr * re, gfc_se *rse, + tree * to_lenp, tree * from_lenp) +{ + gfc_se se; + gfc_expr * vptr_expr; + tree tmp, to_len = NULL_TREE, from_len = NULL_TREE, lhs_vptr; + bool set_vptr = false, temp_rhs = false; + stmtblock_t *pre = block; + + /* Create a temporary for complicated expressions. */ + if (re->expr_type != EXPR_VARIABLE && re->expr_type != EXPR_NULL + && rse->expr != NULL_TREE && !DECL_P (rse->expr)) + { + tmp = gfc_create_var (TREE_TYPE (rse->expr), "rhs"); + pre = &rse->pre; + gfc_add_modify (&rse->pre, tmp, rse->expr); + rse->expr = tmp; + temp_rhs = true; + } + + /* Get the _vptr for the left-hand side expression. */ + gfc_init_se (&se, NULL); + vptr_expr = gfc_find_and_cut_at_last_class_ref (le); + if (vptr_expr != NULL && gfc_expr_attr (vptr_expr).class_ok) + { + /* Care about _len for unlimited polymorphic entities. */ + if (UNLIMITED_POLY (vptr_expr) + || (vptr_expr->ts.type == BT_DERIVED + && vptr_expr->ts.u.derived->attr.unlimited_polymorphic)) + to_len = trans_get_upoly_len (block, vptr_expr); + gfc_add_vptr_component (vptr_expr); + set_vptr = true; + } + else + vptr_expr = gfc_lval_expr_from_sym (gfc_find_vtab (&le->ts)); + se.want_pointer = 1; + gfc_conv_expr (&se, vptr_expr); + gfc_free_expr (vptr_expr); + gfc_add_block_to_block (block, &se.pre); + gcc_assert (se.post.head == NULL_TREE); + lhs_vptr = se.expr; + STRIP_NOPS (lhs_vptr); + + /* Set the _vptr only when the left-hand side of the assignment is a + class-object. */ + if (set_vptr) + { + /* Get the vptr from the rhs expression only, when it is variable. + Functions are expected to be assigned to a temporary beforehand. */ + vptr_expr = re->expr_type == EXPR_VARIABLE + ? gfc_find_and_cut_at_last_class_ref (re) + : NULL; + if (vptr_expr != NULL && vptr_expr->ts.type == BT_CLASS) + { + if (to_len != NULL_TREE) + { + /* Get the _len information from the rhs. */ + if (UNLIMITED_POLY (vptr_expr) + || (vptr_expr->ts.type == BT_DERIVED + && vptr_expr->ts.u.derived->attr.unlimited_polymorphic)) + from_len = trans_get_upoly_len (block, vptr_expr); + } + gfc_add_vptr_component (vptr_expr); + } + else + { + if (re->expr_type == EXPR_VARIABLE + && DECL_P (re->symtree->n.sym->backend_decl) + && DECL_LANG_SPECIFIC (re->symtree->n.sym->backend_decl) + && GFC_DECL_SAVED_DESCRIPTOR (re->symtree->n.sym->backend_decl) + && GFC_CLASS_TYPE_P (TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR ( + re->symtree->n.sym->backend_decl)))) + { + vptr_expr = NULL; + se.expr = gfc_class_vptr_get (GFC_DECL_SAVED_DESCRIPTOR ( + re->symtree->n.sym->backend_decl)); + if (to_len) + from_len = gfc_class_len_get (GFC_DECL_SAVED_DESCRIPTOR ( + re->symtree->n.sym->backend_decl)); + } + else if (temp_rhs && re->ts.type == BT_CLASS) + { + vptr_expr = NULL; + se.expr = gfc_class_vptr_get (rse->expr); + } + else if (re->expr_type != EXPR_NULL) + /* Only when rhs is non-NULL use its declared type for vptr + initialisation. */ + vptr_expr = gfc_lval_expr_from_sym (gfc_find_vtab (&re->ts)); + else + /* When the rhs is NULL use the vtab of lhs' declared type. */ + vptr_expr = gfc_lval_expr_from_sym (gfc_find_vtab (&le->ts)); + } + + if (vptr_expr) + { + gfc_init_se (&se, NULL); + se.want_pointer = 1; + gfc_conv_expr (&se, vptr_expr); + gfc_free_expr (vptr_expr); + gfc_add_block_to_block (block, &se.pre); + gcc_assert (se.post.head == NULL_TREE); + } + gfc_add_modify (pre, lhs_vptr, fold_convert (TREE_TYPE (lhs_vptr), + se.expr)); + + if (to_len != NULL_TREE) + { + /* The _len component needs to be set. Figure how to get the + value of the right-hand side. */ + if (from_len == NULL_TREE) + { + if (rse->string_length != NULL_TREE) + from_len = rse->string_length; + else if (re->ts.type == BT_CHARACTER && re->ts.u.cl->length) + { + from_len = gfc_get_expr_charlen (re); + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, re->ts.u.cl->length); + gfc_add_block_to_block (block, &se.pre); + gcc_assert (se.post.head == NULL_TREE); + from_len = gfc_evaluate_now (se.expr, block); + } + else + from_len = integer_zero_node; + } + gfc_add_modify (pre, to_len, fold_convert (TREE_TYPE (to_len), + from_len)); + } + } + + /* Return the _len trees only, when requested. */ + if (to_lenp) + *to_lenp = to_len; + if (from_lenp) + *from_lenp = from_len; + return lhs_vptr; +} + + +/* Assign tokens for pointer components. */ + +static void +trans_caf_token_assign (gfc_se *lse, gfc_se *rse, gfc_expr *expr1, + gfc_expr *expr2) +{ + symbol_attribute lhs_attr, rhs_attr; + tree tmp, lhs_tok, rhs_tok; + /* Flag to indicated component refs on the rhs. */ + bool rhs_cr; + + lhs_attr = gfc_caf_attr (expr1); + if (expr2->expr_type != EXPR_NULL) + { + rhs_attr = gfc_caf_attr (expr2, false, &rhs_cr); + if (lhs_attr.codimension && rhs_attr.codimension) + { + lhs_tok = gfc_get_ultimate_alloc_ptr_comps_caf_token (lse, expr1); + lhs_tok = build_fold_indirect_ref (lhs_tok); + + if (rhs_cr) + rhs_tok = gfc_get_ultimate_alloc_ptr_comps_caf_token (rse, expr2); + else + { + tree caf_decl; + caf_decl = gfc_get_tree_for_caf_expr (expr2); + gfc_get_caf_token_offset (rse, &rhs_tok, NULL, caf_decl, + NULL_TREE, NULL); + } + tmp = build2_loc (input_location, MODIFY_EXPR, void_type_node, + lhs_tok, + fold_convert (TREE_TYPE (lhs_tok), rhs_tok)); + gfc_prepend_expr_to_block (&lse->post, tmp); + } + } + else if (lhs_attr.codimension) + { + lhs_tok = gfc_get_ultimate_alloc_ptr_comps_caf_token (lse, expr1); + lhs_tok = build_fold_indirect_ref (lhs_tok); + tmp = build2_loc (input_location, MODIFY_EXPR, void_type_node, + lhs_tok, null_pointer_node); + gfc_prepend_expr_to_block (&lse->post, tmp); + } +} + +/* Indentify class valued proc_pointer assignments. */ + +static bool +pointer_assignment_is_proc_pointer (gfc_expr * expr1, gfc_expr * expr2) +{ + gfc_ref * ref; + + ref = expr1->ref; + while (ref && ref->next) + ref = ref->next; + + return ref && ref->type == REF_COMPONENT + && ref->u.c.component->attr.proc_pointer + && expr2->expr_type == EXPR_VARIABLE + && expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE; +} + + tree gfc_trans_pointer_assign (gfc_code * code) { @@ -7757,20 +8207,22 @@ gfc_trans_pointer_assign (gfc_code * code) tree gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) { - gfc_expr *expr1_vptr = NULL; gfc_se lse; gfc_se rse; stmtblock_t block; tree desc; tree tmp; tree decl; - bool scalar; + bool scalar, non_proc_pointer_assign; gfc_ss *ss; gfc_start_block (&block); gfc_init_se (&lse, NULL); + /* Usually testing whether this is not a proc pointer assignment. */ + non_proc_pointer_assign = !pointer_assignment_is_proc_pointer (expr1, expr2); + /* Check whether the expression is a scalar or not; we cannot use expr1->rank as it can be nonzero for proc pointers. */ ss = gfc_walk_expr (expr1); @@ -7779,7 +8231,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_free_ss_chain (ss); if (expr1->ts.type == BT_DERIVED && expr2->ts.type == BT_CLASS - && expr2->expr_type != EXPR_FUNCTION) + && expr2->expr_type != EXPR_FUNCTION && non_proc_pointer_assign) { gfc_add_data_component (expr2); /* The following is required as gfc_add_data_component doesn't @@ -7796,6 +8248,13 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) rse.want_pointer = 1; gfc_conv_expr (&rse, expr2); + if (non_proc_pointer_assign && expr1->ts.type == BT_CLASS) + { + trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, NULL, + NULL); + lse.expr = gfc_class_data_get (lse.expr); + } + if (expr1->symtree->n.sym->attr.proc_pointer && expr1->symtree->n.sym->attr.dummy) lse.expr = build_fold_indirect_ref_loc (input_location, @@ -7809,27 +8268,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &rse.pre); - /* For string assignments to unlimited polymorphic pointers add an - assignment of the string_length to the _len component of the - pointer. */ - if ((expr1->ts.type == BT_CLASS || expr1->ts.type == BT_DERIVED) - && expr1->ts.u.derived->attr.unlimited_polymorphic - && (expr2->ts.type == BT_CHARACTER || - ((expr2->ts.type == BT_DERIVED || expr2->ts.type == BT_CLASS) - && expr2->ts.u.derived->attr.unlimited_polymorphic))) - { - gfc_expr *len_comp; - gfc_se se; - len_comp = gfc_get_len_component (expr1); - gfc_init_se (&se, NULL); - gfc_conv_expr (&se, len_comp); - - /* ptr % _len = len (str) */ - gfc_add_modify (&block, se.expr, rse.string_length); - lse.string_length = se.expr; - gfc_free_expr (len_comp); - } - /* Check character lengths if character expression. The test is only really added if -fbounds-check is enabled. Exclude deferred character length lefthand sides. */ @@ -7856,12 +8294,14 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) build_int_cst (gfc_charlen_type_node, 0)); } - if (expr1->ts.type == BT_DERIVED && expr2->ts.type == BT_CLASS) - rse.expr = gfc_class_data_get (rse.expr); - gfc_add_modify (&block, lse.expr, fold_convert (TREE_TYPE (lse.expr), rse.expr)); + /* Also set the tokens for pointer components in derived typed + coarrays. */ + if (flag_coarray == GFC_FCOARRAY_LIB) + trans_caf_token_assign (&lse, &rse, expr1, expr2); + gfc_add_block_to_block (&block, &rse.post); gfc_add_block_to_block (&block, &lse.post); } @@ -7869,6 +8309,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) { gfc_ref* remap; bool rank_remap; + tree expr1_vptr = NULL_TREE; tree strlen_lhs; tree strlen_rhs = NULL_TREE; @@ -7885,9 +8326,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_init_se (&lse, NULL); if (remap) lse.descriptor_only = 1; - if (expr2->expr_type == EXPR_FUNCTION && expr2->ts.type == BT_CLASS - && expr1->ts.type == BT_CLASS) - expr1_vptr = gfc_copy_expr (expr1); gfc_conv_expr_descriptor (&lse, expr1); strlen_lhs = lse.string_length; desc = lse.expr; @@ -7913,16 +8351,15 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) rse.expr = gfc_class_data_get (rse.expr); else { + expr1_vptr = trans_class_vptr_len_assignment (&block, expr1, + expr2, &rse, + NULL, NULL); gfc_add_block_to_block (&block, &rse.pre); tmp = gfc_create_var (TREE_TYPE (rse.expr), "ptrtemp"); gfc_add_modify (&lse.pre, tmp, rse.expr); - gfc_add_vptr_component (expr1_vptr); - gfc_init_se (&rse, NULL); - rse.want_pointer = 1; - gfc_conv_expr (&rse, expr1_vptr); - gfc_add_modify (&lse.pre, rse.expr, - fold_convert (TREE_TYPE (rse.expr), + gfc_add_modify (&lse.pre, expr1_vptr, + fold_convert (TREE_TYPE (expr1_vptr), gfc_class_vptr_get (tmp))); rse.expr = gfc_class_data_get (tmp); } @@ -7939,17 +8376,21 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) bound, bound, 0, GFC_ARRAY_POINTER_CONT, false); tmp = gfc_create_var (tmp, "ptrtemp"); - lse.descriptor_only = 0; - lse.expr = tmp; - lse.direct_byref = 1; - gfc_conv_expr_descriptor (&lse, expr2); - strlen_rhs = lse.string_length; + rse.descriptor_only = 0; + rse.expr = tmp; + rse.direct_byref = 1; + gfc_conv_expr_descriptor (&rse, expr2); + strlen_rhs = rse.string_length; rse.expr = tmp; } else { gfc_conv_expr_descriptor (&rse, expr2); strlen_rhs = rse.string_length; + if (expr1->ts.type == BT_CLASS) + expr1_vptr = trans_class_vptr_len_assignment (&block, expr1, + expr2, &rse, + NULL, NULL); } } else if (expr2->expr_type == EXPR_VARIABLE) @@ -7968,12 +8409,22 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_init_se (&rse, NULL); rse.descriptor_only = 1; gfc_conv_expr (&rse, expr2); + if (expr1->ts.type == BT_CLASS) + trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, + NULL, NULL); tmp = gfc_get_element_type (TREE_TYPE (rse.expr)); tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp)); if (!INTEGER_CST_P (tmp)) gfc_add_block_to_block (&lse.post, &rse.pre); gfc_add_modify (&lse.post, GFC_DECL_SPAN(decl), tmp); } + else if (expr1->ts.type == BT_CLASS) + { + rse.expr = NULL_TREE; + rse.string_length = NULL_TREE; + trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, + NULL, NULL); + } } else if (expr2->expr_type == EXPR_FUNCTION && expr2->ts.type == BT_CLASS) { @@ -7987,16 +8438,15 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) } else { + expr1_vptr = trans_class_vptr_len_assignment (&block, expr1, + expr2, &rse, NULL, + NULL); gfc_add_block_to_block (&block, &rse.pre); tmp = gfc_create_var (TREE_TYPE (rse.expr), "ptrtemp"); gfc_add_modify (&lse.pre, tmp, rse.expr); - gfc_add_vptr_component (expr1_vptr); - gfc_init_se (&rse, NULL); - rse.want_pointer = 1; - gfc_conv_expr (&rse, expr1_vptr); - gfc_add_modify (&lse.pre, rse.expr, - fold_convert (TREE_TYPE (rse.expr), + gfc_add_modify (&lse.pre, expr1_vptr, + fold_convert (TREE_TYPE (expr1_vptr), gfc_class_vptr_get (tmp))); rse.expr = gfc_class_data_get (tmp); gfc_add_modify (&lse.pre, desc, rse.expr); @@ -8015,9 +8465,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_add_modify (&lse.pre, desc, tmp); } - if (expr1_vptr) - gfc_free_expr (expr1_vptr); - gfc_add_block_to_block (&block, &lse.pre); if (rank_remap) gfc_add_block_to_block (&block, &rse.pre); @@ -8245,7 +8692,7 @@ gfc_conv_string_parameter (gfc_se * se) tree gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, - bool deep_copy, bool dealloc) + bool deep_copy, bool dealloc, bool in_coarray) { stmtblock_t block; tree tmp; @@ -8267,7 +8714,6 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, if (rse->string_length != NULL_TREE) { - gcc_assert (rse->string_length != NULL_TREE); gfc_conv_string_parameter (rse); gfc_add_block_to_block (&block, &rse->pre); rlen = rse->string_length; @@ -8323,7 +8769,10 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, same as the lhs. */ if (deep_copy) { - tmp = gfc_copy_alloc_comp (ts.u.derived, rse->expr, lse->expr, 0); + int caf_mode = in_coarray ? (GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY + | GFC_STRUCTURE_CAF_MODE_IN_COARRAY) : 0; + tmp = gfc_copy_alloc_comp (ts.u.derived, rse->expr, lse->expr, 0, + caf_mode); tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location), tmp); gfc_add_expr_to_block (&block, tmp); @@ -9050,7 +9499,25 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block, size_in_bytes = fold_build2_loc (input_location, MAX_EXPR, size_type_node, size_in_bytes, size_one_node); - if (expr1->ts.type == BT_DERIVED && expr1->ts.u.derived->attr.alloc_comp) + if (gfc_caf_attr (expr1).codimension && flag_coarray == GFC_FCOARRAY_LIB) + { + tree caf_decl, token; + gfc_se caf_se; + symbol_attribute attr; + + gfc_clear_attr (&attr); + gfc_init_se (&caf_se, NULL); + + caf_decl = gfc_get_tree_for_caf_expr (expr1); + gfc_get_caf_token_offset (&caf_se, &token, NULL, caf_decl, NULL_TREE, + NULL); + gfc_add_block_to_block (block, &caf_se.pre); + gfc_allocate_allocatable (block, lse.expr, size_in_bytes, + gfc_build_addr_expr (NULL_TREE, token), + NULL_TREE, NULL_TREE, NULL_TREE, jump_label1, + expr1, 1); + } + else if (expr1->ts.type == BT_DERIVED && expr1->ts.u.derived->attr.alloc_comp) { tmp = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_CALLOC), @@ -9205,14 +9672,122 @@ is_runtime_conformable (gfc_expr *expr1, gfc_expr *expr2) return false; } + +static tree +trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs, + gfc_se *lse, gfc_se *rse, bool use_vptr_copy, + bool class_realloc) +{ + tree tmp, fcn, stdcopy, to_len, from_len, vptr; + vec<tree, va_gc> *args = NULL; + + vptr = trans_class_vptr_len_assignment (block, lhs, rhs, rse, &to_len, + &from_len); + + /* Generate allocation of the lhs. */ + if (class_realloc) + { + stmtblock_t alloc; + tree class_han; + + tmp = gfc_vptr_size_get (vptr); + class_han = GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr)) + ? gfc_class_data_get (lse->expr) : lse->expr; + gfc_init_block (&alloc); + gfc_allocate_using_malloc (&alloc, class_han, tmp, NULL_TREE); + tmp = fold_build2_loc (input_location, EQ_EXPR, + boolean_type_node, class_han, + build_int_cst (prvoid_type_node, 0)); + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, + gfc_unlikely (tmp, + PRED_FORTRAN_FAIL_ALLOC), + gfc_finish_block (&alloc), + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&lse->pre, tmp); + } + + fcn = gfc_vptr_copy_get (vptr); + + tmp = GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr)) + ? gfc_class_data_get (rse->expr) : rse->expr; + if (use_vptr_copy) + { + if (!POINTER_TYPE_P (TREE_TYPE (tmp)) + || INDIRECT_REF_P (tmp) + || (rhs->ts.type == BT_DERIVED + && rhs->ts.u.derived->attr.unlimited_polymorphic + && !rhs->ts.u.derived->attr.pointer + && !rhs->ts.u.derived->attr.allocatable) + || (UNLIMITED_POLY (rhs) + && !CLASS_DATA (rhs)->attr.pointer + && !CLASS_DATA (rhs)->attr.allocatable)) + vec_safe_push (args, gfc_build_addr_expr (NULL_TREE, tmp)); + else + vec_safe_push (args, tmp); + tmp = GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr)) + ? gfc_class_data_get (lse->expr) : lse->expr; + if (!POINTER_TYPE_P (TREE_TYPE (tmp)) + || INDIRECT_REF_P (tmp) + || (lhs->ts.type == BT_DERIVED + && lhs->ts.u.derived->attr.unlimited_polymorphic + && !lhs->ts.u.derived->attr.pointer + && !lhs->ts.u.derived->attr.allocatable) + || (UNLIMITED_POLY (lhs) + && !CLASS_DATA (lhs)->attr.pointer + && !CLASS_DATA (lhs)->attr.allocatable)) + vec_safe_push (args, gfc_build_addr_expr (NULL_TREE, tmp)); + else + vec_safe_push (args, tmp); + + stdcopy = build_call_vec (TREE_TYPE (TREE_TYPE (fcn)), fcn, args); + + if (to_len != NULL_TREE && !integer_zerop (from_len)) + { + tree extcopy; + vec_safe_push (args, from_len); + vec_safe_push (args, to_len); + extcopy = build_call_vec (TREE_TYPE (TREE_TYPE (fcn)), fcn, args); + + tmp = fold_build2_loc (input_location, GT_EXPR, + boolean_type_node, from_len, + integer_zero_node); + return fold_build3_loc (input_location, COND_EXPR, + void_type_node, tmp, + extcopy, stdcopy); + } + else + return stdcopy; + } + else + { + tree rhst = GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr)) + ? gfc_class_data_get (lse->expr) : lse->expr; + stmtblock_t tblock; + gfc_init_block (&tblock); + if (!POINTER_TYPE_P (TREE_TYPE (tmp))) + tmp = gfc_build_addr_expr (NULL_TREE, tmp); + if (!POINTER_TYPE_P (TREE_TYPE (rhst))) + rhst = gfc_build_addr_expr (NULL_TREE, rhst); + /* When coming from a ptr_copy lhs and rhs are swapped. */ + gfc_add_modify_loc (input_location, &tblock, rhst, + fold_convert (TREE_TYPE (rhst), tmp)); + return gfc_finish_block (&tblock); + } +} + /* Subroutine of gfc_trans_assignment that actually scalarizes the assignment. EXPR1 is the destination/LHS and EXPR2 is the source/RHS. init_flag indicates initialization expressions and dealloc that no - deallocate prior assignment is needed (if in doubt, set true). */ + deallocate prior assignment is needed (if in doubt, set true). + When PTR_COPY is set and expr1 is a class type, then use the _vptr-copy + routine instead of a pointer assignment. Alias resolution is only done, + when MAY_ALIAS is set (the default). This flag is used by ALLOCATE() + where it is known, that newly allocated memory on the lhs can never be + an alias of the rhs. */ static tree gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, - bool dealloc) + bool dealloc, bool use_vptr_copy, bool may_alias) { gfc_se lse; gfc_se rse; @@ -9227,7 +9802,9 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, bool scalar_to_array; tree string_length; int n; - bool maybe_workshare = false; + bool maybe_workshare = false, lhs_refs_comp = false, rhs_refs_comp = false; + symbol_attribute lhs_caf_attr, rhs_caf_attr, lhs_attr; + bool is_poly_assign; /* Assignment of the form lhs = rhs. */ gfc_start_block (&block); @@ -9248,6 +9825,27 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, || gfc_is_alloc_class_scalar_function (expr2))) expr2->must_finalize = 1; + /* Checking whether a class assignment is desired is quite complicated and + needed at two locations, so do it once only before the information is + needed. */ + lhs_attr = gfc_expr_attr (expr1); + is_poly_assign = (use_vptr_copy || lhs_attr.pointer + || (lhs_attr.allocatable && !lhs_attr.dimension)) + && (expr1->ts.type == BT_CLASS + || gfc_is_class_array_ref (expr1, NULL) + || gfc_is_class_scalar_expr (expr1) + || gfc_is_class_array_ref (expr2, NULL) + || gfc_is_class_scalar_expr (expr2)); + + + /* Only analyze the expressions for coarray properties, when in coarray-lib + mode. */ + if (flag_coarray == GFC_FCOARRAY_LIB) + { + lhs_caf_attr = gfc_caf_attr (expr1, false, &lhs_refs_comp); + rhs_caf_attr = gfc_caf_attr (expr2, false, &rhs_refs_comp); + } + if (lss != gfc_ss_terminator) { /* The assignment needs scalarization. */ @@ -9268,6 +9866,10 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, if (rss == gfc_ss_terminator) /* The rhs is scalar. Add a ss for the expression. */ rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2); + /* When doing a class assign, then the handle to the rhs needs to be a + pointer to allow for polymorphism. */ + if (is_poly_assign && expr2->rank == 0 && !UNLIMITED_POLY (expr2)) + rss->info->type = GFC_SS_REFERENCE; /* Associate the SS with the loop. */ gfc_add_ss_to_loop (&loop, lss); @@ -9279,7 +9881,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, for (n = 0; n < GFC_MAX_DIMENSIONS; n++) loop.reverse[n] = GFC_ENABLE_REVERSE; /* Resolve any data dependencies in the statement. */ - gfc_conv_resolve_dependencies (&loop, lss, rss); + if (may_alias) + gfc_conv_resolve_dependencies (&loop, lss, rss); /* Setup the scalarizing loops. */ gfc_conv_loop_setup (&loop, &expr2->where); @@ -9319,6 +9922,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, l_is_temp = (lss != gfc_ss_terminator && loop.temp_ss != NULL); /* Translate the expression. */ + rse.want_coarray = flag_coarray == GFC_FCOARRAY_LIB && init_flag + && lhs_caf_attr.codimension; gfc_conv_expr (&rse, expr2); /* Deal with the case of a scalar class function assigned to a derived type. */ @@ -9331,7 +9936,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, /* Stabilize a string length for temporaries. */ if (expr2->ts.type == BT_CHARACTER && !expr1->ts.deferred - && !(TREE_CODE (rse.string_length) == VAR_DECL + && !(VAR_P (rse.string_length) || TREE_CODE (rse.string_length) == PARM_DECL || TREE_CODE (rse.string_length) == INDIRECT_REF)) string_length = gfc_evaluate_now (rse.string_length, &rse.pre); @@ -9358,13 +9963,16 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, tree cond; const char* msg; + tmp = INDIRECT_REF_P (lse.expr) + ? gfc_build_addr_expr (NULL_TREE, lse.expr) : lse.expr; + /* We should only get array references here. */ - gcc_assert (TREE_CODE (lse.expr) == POINTER_PLUS_EXPR - || TREE_CODE (lse.expr) == ARRAY_REF); + gcc_assert (TREE_CODE (tmp) == POINTER_PLUS_EXPR + || TREE_CODE (tmp) == ARRAY_REF); /* 'tmp' is either the pointer to the array(POINTER_PLUS_EXPR) or the array itself(ARRAY_REF). */ - tmp = TREE_OPERAND (lse.expr, 0); + tmp = TREE_OPERAND (tmp, 0); /* Provide the address of the array. */ if (TREE_CODE (lse.expr) == ARRAY_REF) @@ -9415,9 +10023,9 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, nullification occurs before the call to the finalizer. In the case of a scalar to array assignment, this is done in gfc_trans_scalar_assign as part of the deep copy. */ - if (!scalar_to_array && (expr1->ts.type == BT_DERIVED) - && (gfc_is_alloc_class_array_function (expr2) - || gfc_is_alloc_class_scalar_function (expr2))) + if (!scalar_to_array && expr1->ts.type == BT_DERIVED + && (gfc_is_alloc_class_array_function (expr2) + || gfc_is_alloc_class_scalar_function (expr2))) { tmp = rse.expr; tmp = gfc_nullify_alloc_comp (expr1->ts.u.derived, rse.expr, 0); @@ -9426,16 +10034,54 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, gfc_add_block_to_block (&loop.post, &rse.post); } - tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts, - gfc_expr_is_variable (expr2) || scalar_to_array - || expr2->expr_type == EXPR_ARRAY, - !(l_is_temp || init_flag) && dealloc); + if (is_poly_assign) + tmp = trans_class_assignment (&body, expr1, expr2, &lse, &rse, + use_vptr_copy || (lhs_attr.allocatable + && !lhs_attr.dimension), + flag_realloc_lhs && !lhs_attr.pointer); + else if (flag_coarray == GFC_FCOARRAY_LIB + && lhs_caf_attr.codimension && rhs_caf_attr.codimension + && ((lhs_caf_attr.allocatable && lhs_refs_comp) + || (rhs_caf_attr.allocatable && rhs_refs_comp))) + { + /* Only detour to caf_send[get][_by_ref] () when the lhs or rhs is an + allocatable component, because those need to be accessed via the + caf-runtime. No need to check for coindexes here, because resolve + has rewritten those already. */ + gfc_code code; + gfc_actual_arglist a1, a2; + /* Clear the structures to prevent accessing garbage. */ + memset (&code, '\0', sizeof (gfc_code)); + memset (&a1, '\0', sizeof (gfc_actual_arglist)); + memset (&a2, '\0', sizeof (gfc_actual_arglist)); + a1.expr = expr1; + a1.next = &a2; + a2.expr = expr2; + a2.next = NULL; + code.ext.actual = &a1; + code.resolved_isym = gfc_intrinsic_subroutine_by_id (GFC_ISYM_CAF_SEND); + tmp = gfc_conv_intrinsic_subroutine (&code); + } + else + tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts, + gfc_expr_is_variable (expr2) + || scalar_to_array + || expr2->expr_type == EXPR_ARRAY, + !(l_is_temp || init_flag) && dealloc, + expr1->symtree->n.sym->attr.codimension); + /* Add the pre blocks to the body. */ + gfc_add_block_to_block (&body, &rse.pre); + gfc_add_block_to_block (&body, &lse.pre); gfc_add_expr_to_block (&body, tmp); + /* Add the post blocks to the body. */ + gfc_add_block_to_block (&body, &rse.post); + gfc_add_block_to_block (&body, &lse.post); if (lss == gfc_ss_terminator) { /* F2003: Add the code for reallocation on assignment. */ - if (flag_realloc_lhs && is_scalar_reallocatable_lhs (expr1)) + if (flag_realloc_lhs && is_scalar_reallocatable_lhs (expr1) + && !is_poly_assign) alloc_scalar_allocatable_for_assignment (&block, string_length, expr1, expr2); @@ -9476,11 +10122,9 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, /* F2003: Allocate or reallocate lhs of allocatable array. */ if (flag_realloc_lhs - && gfc_is_reallocatable_lhs (expr1) - && !gfc_expr_attr (expr1).codimension - && !gfc_is_coindexed (expr1) - && expr2->rank - && !is_runtime_conformable (expr1, expr2)) + && gfc_is_reallocatable_lhs (expr1) + && expr2->rank + && !is_runtime_conformable (expr1, expr2)) { realloc_lhs_warning (expr1->ts.type, true, &expr1->where); ompws_flags &= ~OMPWS_SCALARIZER_WS; @@ -9547,7 +10191,7 @@ copyable_array_p (gfc_expr * expr) tree gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, - bool dealloc) + bool dealloc, bool use_vptr_copy, bool may_alias) { tree tmp; @@ -9590,13 +10234,14 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, } /* Fallback to the scalarizer to generate explicit loops. */ - return gfc_trans_assignment_1 (expr1, expr2, init_flag, dealloc); + return gfc_trans_assignment_1 (expr1, expr2, init_flag, dealloc, + use_vptr_copy, may_alias); } tree gfc_trans_init_assign (gfc_code * code) { - return gfc_trans_assignment (code->expr1, code->expr2, true, false); + return gfc_trans_assignment (code->expr1, code->expr2, true, false, true); } tree diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 1aaf4e256b..3c9e1d5e03 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1,5 +1,5 @@ /* Intrinsic translation - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -24,6 +24,7 @@ along with GCC; see the file COPYING3. If not see #include "config.h" #include "system.h" #include "coretypes.h" +#include "memmodel.h" #include "tm.h" /* For UNITS_PER_WORD. */ #include "tree.h" #include "gfortran.h" @@ -149,7 +150,7 @@ builtin_decl_for_precision (enum built_in_function base_built_in, i = m->double_built_in; else if (precision == TYPE_PRECISION (long_double_type_node)) i = m->long_double_built_in; - else if (precision == TYPE_PRECISION (float128_type_node)) + else if (precision == TYPE_PRECISION (gfc_float128_type_node)) { /* Special treatment, because it is not exactly a built-in, but a library function. */ @@ -410,19 +411,15 @@ build_fix_expr (stmtblock_t * pblock, tree arg, tree type, { case RND_FLOOR: return build_fixbound_expr (pblock, arg, type, 0); - break; case RND_CEIL: return build_fixbound_expr (pblock, arg, type, 1); - break; case RND_ROUND: return build_round_expr (arg, type); - break; case RND_TRUNC: return fold_build1_loc (input_location, FIX_TRUNC_EXPR, type, arg); - break; default: gcc_unreachable (); @@ -621,8 +618,8 @@ gfc_build_intrinsic_lib_fndecls (void) memset (quad_decls, 0, sizeof(tree) * (END_BUILTINS + 1)); - type = float128_type_node; - complex_type = complex_float128_type_node; + type = gfc_float128_type_node; + complex_type = gfc_complex_float128_type_node; /* type (*) (type) */ func_1 = build_function_type_list (type, type, NULL_TREE); /* int (*) (type) */ @@ -982,7 +979,7 @@ conv_caf_vector_subscript_elem (stmtblock_t *block, int i, tree desc, if (vector != NULL_TREE) { - /* Set dim.lower/upper/stride. */ + /* Set vector and kind. */ field = gfc_advance_chain (TYPE_FIELDS (type), 0); tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); @@ -994,7 +991,7 @@ conv_caf_vector_subscript_elem (stmtblock_t *block, int i, tree desc, } else { - /* Set vector and kind. */ + /* Set dim.lower/upper/stride. */ field = gfc_advance_chain (TYPE_FIELDS (type), 0); tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); @@ -1094,16 +1091,505 @@ conv_caf_vector_subscript (stmtblock_t *block, tree desc, gfc_array_ref *ar) } +static tree +compute_component_offset (tree field, tree type) +{ + tree tmp; + if (DECL_FIELD_BIT_OFFSET (field) != NULL_TREE + && !integer_zerop (DECL_FIELD_BIT_OFFSET (field))) + { + tmp = fold_build2 (TRUNC_DIV_EXPR, type, + DECL_FIELD_BIT_OFFSET (field), + bitsize_unit_node); + return fold_build2 (PLUS_EXPR, type, DECL_FIELD_OFFSET (field), tmp); + } + else + return DECL_FIELD_OFFSET (field); +} + + +static tree +conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr *expr) +{ + gfc_ref *ref = expr->ref, *last_comp_ref; + tree caf_ref = NULL_TREE, prev_caf_ref = NULL_TREE, reference_type, tmp, tmp2, + field, last_type, inner_struct, mode, mode_rhs, dim_array, dim, dim_type, + start, end, stride, vector, nvec; + gfc_se se; + bool ref_static_array = false; + tree last_component_ref_tree = NULL_TREE; + int i, last_type_n; + + if (expr->symtree) + { + last_component_ref_tree = expr->symtree->n.sym->backend_decl; + ref_static_array = !expr->symtree->n.sym->attr.allocatable + && !expr->symtree->n.sym->attr.pointer; + } + + /* Prevent uninit-warning. */ + reference_type = NULL_TREE; + + /* Skip refs upto the first coarray-ref. */ + last_comp_ref = NULL; + while (ref && (ref->type != REF_ARRAY || ref->u.ar.codimen == 0)) + { + /* Remember the type of components skipped. */ + if (ref->type == REF_COMPONENT) + last_comp_ref = ref; + ref = ref->next; + } + /* When a component was skipped, get the type information of the last + component ref, else get the type from the symbol. */ + if (last_comp_ref) + { + last_type = gfc_typenode_for_spec (&last_comp_ref->u.c.component->ts); + last_type_n = last_comp_ref->u.c.component->ts.type; + } + else + { + last_type = gfc_typenode_for_spec (&expr->symtree->n.sym->ts); + last_type_n = expr->symtree->n.sym->ts.type; + } + + while (ref) + { + if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0 + && ref->u.ar.dimen == 0) + { + /* Skip pure coindexes. */ + ref = ref->next; + continue; + } + tmp = gfc_create_var (gfc_get_caf_reference_type (), "caf_ref"); + reference_type = TREE_TYPE (tmp); + + if (caf_ref == NULL_TREE) + caf_ref = tmp; + + /* Construct the chain of refs. */ + if (prev_caf_ref != NULL_TREE) + { + field = gfc_advance_chain (TYPE_FIELDS (reference_type), 0); + tmp2 = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), prev_caf_ref, field, + NULL_TREE); + gfc_add_modify (block, tmp2, gfc_build_addr_expr (TREE_TYPE (field), + tmp)); + } + prev_caf_ref = tmp; + + switch (ref->type) + { + case REF_COMPONENT: + last_type = gfc_typenode_for_spec (&ref->u.c.component->ts); + last_type_n = ref->u.c.component->ts.type; + /* Set the type of the ref. */ + field = gfc_advance_chain (TYPE_FIELDS (reference_type), 1); + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), prev_caf_ref, field, + NULL_TREE); + gfc_add_modify (block, tmp, build_int_cst (integer_type_node, + GFC_CAF_REF_COMPONENT)); + + /* Ref the c in union u. */ + field = gfc_advance_chain (TYPE_FIELDS (reference_type), 3); + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), prev_caf_ref, field, + NULL_TREE); + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (field)), 0); + inner_struct = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), tmp, field, + NULL_TREE); + + /* Set the offset. */ + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)), 0); + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), inner_struct, field, + NULL_TREE); + /* Computing the offset is somewhat harder. The bit_offset has to be + taken into account. When the bit_offset in the field_decl is non- + null, divide it by the bitsize_unit and add it to the regular + offset. */ + tmp2 = compute_component_offset (ref->u.c.component->backend_decl, + TREE_TYPE (tmp)); + gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (tmp), tmp2)); + + /* Set caf_token_offset. */ + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)), 1); + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), inner_struct, field, + NULL_TREE); + if ((ref->u.c.component->attr.allocatable + || ref->u.c.component->attr.pointer) + && ref->u.c.component->attr.dimension) + { + tree arr_desc_token_offset; + /* Get the token from the descriptor. */ + arr_desc_token_offset = gfc_advance_chain ( + TYPE_FIELDS (TREE_TYPE (ref->u.c.component->backend_decl)), + 4 /* CAF_TOKEN_FIELD */); + arr_desc_token_offset + = compute_component_offset (arr_desc_token_offset, + TREE_TYPE (tmp)); + tmp2 = fold_build2_loc (input_location, PLUS_EXPR, + TREE_TYPE (tmp2), tmp2, + arr_desc_token_offset); + } + else if (ref->u.c.component->caf_token) + tmp2 = compute_component_offset (ref->u.c.component->caf_token, + TREE_TYPE (tmp)); + else + tmp2 = integer_zero_node; + gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (tmp), tmp2)); + + /* Remember whether this ref was to a non-allocatable/non-pointer + component so the next array ref can be tailored correctly. */ + ref_static_array = !ref->u.c.component->attr.allocatable + && !ref->u.c.component->attr.pointer; + last_component_ref_tree = ref_static_array + ? ref->u.c.component->backend_decl : NULL_TREE; + break; + case REF_ARRAY: + if (ref_static_array && ref->u.ar.as->type == AS_DEFERRED) + ref_static_array = false; + /* Set the type of the ref. */ + field = gfc_advance_chain (TYPE_FIELDS (reference_type), 1); + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), prev_caf_ref, field, + NULL_TREE); + gfc_add_modify (block, tmp, build_int_cst (integer_type_node, + ref_static_array + ? GFC_CAF_REF_STATIC_ARRAY + : GFC_CAF_REF_ARRAY)); + + /* Ref the a in union u. */ + field = gfc_advance_chain (TYPE_FIELDS (reference_type), 3); + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), prev_caf_ref, field, + NULL_TREE); + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (field)), 1); + inner_struct = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), tmp, field, + NULL_TREE); + + /* Set the static_array_type in a for static arrays. */ + if (ref_static_array) + { + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)), + 1); + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), inner_struct, field, + NULL_TREE); + gfc_add_modify (block, tmp, build_int_cst (TREE_TYPE (tmp), + last_type_n)); + } + /* Ref the mode in the inner_struct. */ + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)), 0); + mode = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), inner_struct, field, + NULL_TREE); + /* Ref the dim in the inner_struct. */ + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (inner_struct)), 2); + dim_array = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), inner_struct, field, + NULL_TREE); + for (i = 0; i < ref->u.ar.dimen; ++i) + { + /* Ref dim i. */ + dim = gfc_build_array_ref (dim_array, gfc_rank_cst[i], NULL_TREE); + dim_type = TREE_TYPE (dim); + mode_rhs = start = end = stride = NULL_TREE; + switch (ref->u.ar.dimen_type[i]) + { + case DIMEN_RANGE: + if (ref->u.ar.end[i]) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, ref->u.ar.end[i]); + gfc_add_block_to_block (block, &se.pre); + if (ref_static_array) + { + /* Make the index zero-based, when reffing a static + array. */ + end = se.expr; + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, ref->u.ar.as->lower[i]); + gfc_add_block_to_block (block, &se.pre); + se.expr = fold_build2 (MINUS_EXPR, + gfc_array_index_type, + end, fold_convert ( + gfc_array_index_type, + se.expr)); + } + end = gfc_evaluate_now (fold_convert ( + gfc_array_index_type, + se.expr), + block); + } + else if (ref_static_array) + end = fold_build2 (MINUS_EXPR, + gfc_array_index_type, + gfc_conv_array_ubound ( + last_component_ref_tree, i), + gfc_conv_array_lbound ( + last_component_ref_tree, i)); + else + { + end = NULL_TREE; + mode_rhs = build_int_cst (unsigned_char_type_node, + GFC_CAF_ARR_REF_OPEN_END); + } + if (ref->u.ar.stride[i]) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, ref->u.ar.stride[i]); + gfc_add_block_to_block (block, &se.pre); + stride = gfc_evaluate_now (fold_convert ( + gfc_array_index_type, + se.expr), + block); + if (ref_static_array) + { + /* Make the index zero-based, when reffing a static + array. */ + stride = fold_build2 (MULT_EXPR, + gfc_array_index_type, + gfc_conv_array_stride ( + last_component_ref_tree, + i), + stride); + gcc_assert (end != NULL_TREE); + /* Multiply with the product of array's stride and + the step of the ref to a virtual upper bound. + We can not compute the actual upper bound here or + the caflib would compute the extend + incorrectly. */ + end = fold_build2 (MULT_EXPR, gfc_array_index_type, + end, gfc_conv_array_stride ( + last_component_ref_tree, + i)); + end = gfc_evaluate_now (end, block); + stride = gfc_evaluate_now (stride, block); + } + } + else if (ref_static_array) + { + stride = gfc_conv_array_stride (last_component_ref_tree, + i); + end = fold_build2 (MULT_EXPR, gfc_array_index_type, + end, stride); + end = gfc_evaluate_now (end, block); + } + else + /* Always set a ref stride of one to make caflib's + handling easier. */ + stride = gfc_index_one_node; + + /* Fall through. */ + case DIMEN_ELEMENT: + if (ref->u.ar.start[i]) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, ref->u.ar.start[i]); + gfc_add_block_to_block (block, &se.pre); + if (ref_static_array) + { + /* Make the index zero-based, when reffing a static + array. */ + start = fold_convert (gfc_array_index_type, se.expr); + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, ref->u.ar.as->lower[i]); + gfc_add_block_to_block (block, &se.pre); + se.expr = fold_build2 (MINUS_EXPR, + gfc_array_index_type, + start, fold_convert ( + gfc_array_index_type, + se.expr)); + /* Multiply with the stride. */ + se.expr = fold_build2 (MULT_EXPR, + gfc_array_index_type, + se.expr, + gfc_conv_array_stride ( + last_component_ref_tree, + i)); + } + start = gfc_evaluate_now (fold_convert ( + gfc_array_index_type, + se.expr), + block); + if (mode_rhs == NULL_TREE) + mode_rhs = build_int_cst (unsigned_char_type_node, + ref->u.ar.dimen_type[i] + == DIMEN_ELEMENT + ? GFC_CAF_ARR_REF_SINGLE + : GFC_CAF_ARR_REF_RANGE); + } + else if (ref_static_array) + { + start = integer_zero_node; + mode_rhs = build_int_cst (unsigned_char_type_node, + ref->u.ar.start[i] == NULL + ? GFC_CAF_ARR_REF_FULL + : GFC_CAF_ARR_REF_RANGE); + } + else if (end == NULL_TREE) + mode_rhs = build_int_cst (unsigned_char_type_node, + GFC_CAF_ARR_REF_FULL); + else + mode_rhs = build_int_cst (unsigned_char_type_node, + GFC_CAF_ARR_REF_OPEN_START); + + /* Ref the s in dim. */ + field = gfc_advance_chain (TYPE_FIELDS (dim_type), 0); + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), dim, field, + NULL_TREE); + + /* Set start in s. */ + if (start != NULL_TREE) + { + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), + 0); + tmp2 = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), tmp, field, + NULL_TREE); + gfc_add_modify (block, tmp2, + fold_convert (TREE_TYPE (tmp2), start)); + } + + /* Set end in s. */ + if (end != NULL_TREE) + { + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), + 1); + tmp2 = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), tmp, field, + NULL_TREE); + gfc_add_modify (block, tmp2, + fold_convert (TREE_TYPE (tmp2), end)); + } + + /* Set end in s. */ + if (stride != NULL_TREE) + { + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), + 2); + tmp2 = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), tmp, field, + NULL_TREE); + gfc_add_modify (block, tmp2, + fold_convert (TREE_TYPE (tmp2), stride)); + } + break; + case DIMEN_VECTOR: + /* TODO: In case of static array. */ + gcc_assert (!ref_static_array); + mode_rhs = build_int_cst (unsigned_char_type_node, + GFC_CAF_ARR_REF_VECTOR); + gfc_init_se (&se, NULL); + se.descriptor_only = 1; + gfc_conv_expr_descriptor (&se, ref->u.ar.start[i]); + gfc_add_block_to_block (block, &se.pre); + vector = se.expr; + tmp = gfc_conv_descriptor_lbound_get (vector, + gfc_rank_cst[0]); + tmp2 = gfc_conv_descriptor_ubound_get (vector, + gfc_rank_cst[0]); + nvec = gfc_conv_array_extent_dim (tmp, tmp2, NULL); + tmp = gfc_conv_descriptor_stride_get (vector, + gfc_rank_cst[0]); + nvec = fold_build2_loc (input_location, TRUNC_DIV_EXPR, + TREE_TYPE (nvec), nvec, tmp); + vector = gfc_conv_descriptor_data_get (vector); + + /* Ref the v in dim. */ + field = gfc_advance_chain (TYPE_FIELDS (dim_type), 1); + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), dim, field, + NULL_TREE); + + /* Set vector in v. */ + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), 0); + tmp2 = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), tmp, field, + NULL_TREE); + gfc_add_modify (block, tmp2, fold_convert (TREE_TYPE (tmp2), + vector)); + + /* Set nvec in v. */ + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), 1); + tmp2 = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), tmp, field, + NULL_TREE); + gfc_add_modify (block, tmp2, fold_convert (TREE_TYPE (tmp2), + nvec)); + + /* Set kind in v. */ + field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), 2); + tmp2 = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), tmp, field, + NULL_TREE); + gfc_add_modify (block, tmp2, build_int_cst (integer_type_node, + ref->u.ar.start[i]->ts.kind)); + break; + default: + gcc_unreachable (); + } + /* Set the mode for dim i. */ + tmp = gfc_build_array_ref (mode, gfc_rank_cst[i], NULL_TREE); + gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (tmp), + mode_rhs)); + } + + /* Set the mode for dim i+1 to GFC_ARR_REF_NONE. */ + if (i < GFC_MAX_DIMENSIONS) + { + tmp = gfc_build_array_ref (mode, gfc_rank_cst[i], NULL_TREE); + gfc_add_modify (block, tmp, + build_int_cst (unsigned_char_type_node, + GFC_CAF_ARR_REF_NONE)); + } + break; + default: + gcc_unreachable (); + } + + /* Set the size of the current type. */ + field = gfc_advance_chain (TYPE_FIELDS (reference_type), 2); + tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), + prev_caf_ref, field, NULL_TREE); + gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (field), + TYPE_SIZE_UNIT (last_type))); + + ref = ref->next; + } + + if (prev_caf_ref != NULL_TREE) + { + field = gfc_advance_chain (TYPE_FIELDS (reference_type), 0); + tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), + prev_caf_ref, field, NULL_TREE); + gfc_add_modify (block, tmp, fold_convert (TREE_TYPE (field), + null_pointer_node)); + } + return caf_ref != NULL_TREE ? gfc_build_addr_expr (NULL_TREE, caf_ref) + : NULL_TREE; +} + /* Get data from a remote coarray. */ static void gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, - tree may_require_tmp) + tree may_require_tmp, bool may_realloc, + symbol_attribute *caf_attr) { - gfc_expr *array_expr; + gfc_expr *array_expr, *tmp_stat; gfc_se argse; tree caf_decl, token, offset, image_index, tmp; - tree res_var, dst_var, type, kind, vec; + tree res_var, dst_var, type, kind, vec, stat; + tree caf_reference; + symbol_attribute caf_attr_store; gcc_assert (flag_coarray == GFC_FCOARRAY_LIB); @@ -1118,10 +1604,131 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, array_expr = (lhs == NULL_TREE) ? expr->value.function.actual->expr : expr; type = gfc_typenode_for_spec (&array_expr->ts); + if (caf_attr == NULL) + { + caf_attr_store = gfc_caf_attr (array_expr); + caf_attr = &caf_attr_store; + } + res_var = lhs; dst_var = lhs; vec = null_pointer_node; + tmp_stat = gfc_find_stat_co (expr); + + if (tmp_stat) + { + gfc_se stat_se; + gfc_init_se (&stat_se, NULL); + gfc_conv_expr_reference (&stat_se, tmp_stat); + stat = stat_se.expr; + gfc_add_block_to_block (&se->pre, &stat_se.pre); + gfc_add_block_to_block (&se->post, &stat_se.post); + } + else + stat = null_pointer_node; + + /* Only use the new get_by_ref () where it is necessary. I.e., when the lhs + is reallocatable or the right-hand side has allocatable components. */ + if (caf_attr->alloc_comp || caf_attr->pointer_comp || may_realloc) + { + /* Get using caf_get_by_ref. */ + caf_reference = conv_expr_ref_to_caf_ref (&se->pre, array_expr); + + if (caf_reference != NULL_TREE) + { + if (lhs == NULL_TREE) + { + if (array_expr->ts.type == BT_CHARACTER) + gfc_init_se (&argse, NULL); + if (array_expr->rank == 0) + { + symbol_attribute attr; + gfc_clear_attr (&attr); + if (array_expr->ts.type == BT_CHARACTER) + { + res_var = gfc_conv_string_tmp (se, + build_pointer_type (type), + array_expr->ts.u.cl->backend_decl); + argse.string_length = array_expr->ts.u.cl->backend_decl; + } + else + res_var = gfc_create_var (type, "caf_res"); + dst_var = gfc_conv_scalar_to_descriptor (se, res_var, attr); + dst_var = gfc_build_addr_expr (NULL_TREE, dst_var); + } + else + { + /* Create temporary. */ + if (array_expr->ts.type == BT_CHARACTER) + gfc_conv_expr_descriptor (&argse, array_expr); + may_realloc = gfc_trans_create_temp_array (&se->pre, + &se->post, + se->ss, type, + NULL_TREE, false, + false, false, + &array_expr->where) + == NULL_TREE; + res_var = se->ss->info->data.array.descriptor; + dst_var = gfc_build_addr_expr (NULL_TREE, res_var); + if (may_realloc) + { + tmp = gfc_conv_descriptor_data_get (res_var); + tmp = gfc_deallocate_with_status (tmp, NULL_TREE, + NULL_TREE, NULL_TREE, + NULL_TREE, true, + NULL, + GFC_CAF_COARRAY_NOCOARRAY); + gfc_add_expr_to_block (&se->post, tmp); + } + } + } + + kind = build_int_cst (integer_type_node, expr->ts.kind); + if (lhs_kind == NULL_TREE) + lhs_kind = kind; + + caf_decl = gfc_get_tree_for_caf_expr (array_expr); + if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE) + caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl); + image_index = gfc_caf_get_image_index (&se->pre, array_expr, + caf_decl); + gfc_get_caf_token_offset (se, &token, NULL, caf_decl, NULL, + array_expr); + + /* No overlap possible as we have generated a temporary. */ + if (lhs == NULL_TREE) + may_require_tmp = boolean_false_node; + + /* It guarantees memory consistency within the same segment. */ + tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"); + tmp = build5_loc (input_location, ASM_EXPR, void_type_node, + gfc_build_string_const (1, ""), NULL_TREE, + NULL_TREE, tree_cons (NULL_TREE, tmp, NULL_TREE), + NULL_TREE); + ASM_VOLATILE_P (tmp) = 1; + gfc_add_expr_to_block (&se->pre, tmp); + + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get_by_ref, + 9, token, image_index, dst_var, + caf_reference, lhs_kind, kind, + may_require_tmp, + may_realloc ? boolean_true_node : + boolean_false_node, + stat); + + gfc_add_expr_to_block (&se->pre, tmp); + + if (se->ss) + gfc_advance_se_ss_chain (se); + + se->expr = res_var; + if (array_expr->ts.type == BT_CHARACTER) + se->string_length = argse.string_length; + + return; + } + } gfc_init_se (&argse, NULL); if (array_expr->rank == 0) @@ -1161,11 +1768,12 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, ar->as = ar2.as; ar->type = AR_FULL; } + // TODO: Check whether argse.want_coarray = 1 can help with the below. gfc_conv_expr_descriptor (&argse, array_expr); /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that - has the wrong type if component references are done. */ + has the wrong type if component references are done. */ gfc_add_modify (&argse.pre, gfc_conv_descriptor_dtype (argse.expr), - gfc_get_dtype_rank_type (has_vector ? ar2.dimen + gfc_get_dtype_rank_type (has_vector ? ar2.dimen : array_expr->rank, type)); if (has_vector) @@ -1180,10 +1788,10 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, for (int n = 0; n < se->ss->loop->dimen; n++) if (se->loop->to[n] == NULL_TREE) { - se->loop->from[n] = - gfc_conv_descriptor_lbound_get (argse.expr, gfc_rank_cst[n]); - se->loop->to[n] = - gfc_conv_descriptor_ubound_get (argse.expr, gfc_rank_cst[n]); + se->loop->from[n] = gfc_conv_descriptor_lbound_get (argse.expr, + gfc_rank_cst[n]); + se->loop->to[n] = gfc_conv_descriptor_ubound_get (argse.expr, + gfc_rank_cst[n]); } gfc_trans_create_temp_array (&argse.pre, &argse.post, se->ss, type, NULL_TREE, false, true, false, @@ -1205,23 +1813,25 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE) caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl); image_index = gfc_caf_get_image_index (&se->pre, array_expr, caf_decl); - gfc_get_caf_token_offset (&token, &offset, caf_decl, argse.expr, array_expr); + gfc_get_caf_token_offset (se, &token, &offset, caf_decl, argse.expr, + array_expr); /* No overlap possible as we have generated a temporary. */ if (lhs == NULL_TREE) may_require_tmp = boolean_false_node; - /* It guarantees memory consistency within the same segment */ - tmp = gfc_build_string_const (strlen ("memory")+1, "memory"), + /* It guarantees memory consistency within the same segment. */ + tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"); tmp = build5_loc (input_location, ASM_EXPR, void_type_node, gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE, tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE); ASM_VOLATILE_P (tmp) = 1; gfc_add_expr_to_block (&se->pre, tmp); - tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9, + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10, token, offset, image_index, argse.expr, vec, - dst_var, kind, lhs_kind, may_require_tmp); + dst_var, kind, lhs_kind, may_require_tmp, stat); + gfc_add_expr_to_block (&se->pre, tmp); if (se->ss) @@ -1233,17 +1843,18 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, } -/* Send data to a remove coarray. */ +/* Send data to a remote coarray. */ static tree conv_caf_send (gfc_code *code) { - gfc_expr *lhs_expr, *rhs_expr; + gfc_expr *lhs_expr, *rhs_expr, *tmp_stat; gfc_se lhs_se, rhs_se; stmtblock_t block; tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind; - tree may_require_tmp; + tree may_require_tmp, src_stat, dst_stat; tree lhs_type = NULL_TREE; tree vec = null_pointer_node, rhs_vec = null_pointer_node; + symbol_attribute lhs_caf_attr, rhs_caf_attr; gcc_assert (flag_coarray == GFC_FCOARRAY_LIB); @@ -1253,6 +1864,10 @@ conv_caf_send (gfc_code *code) { ? boolean_false_node : boolean_true_node; gfc_init_block (&block); + lhs_caf_attr = gfc_caf_attr (lhs_expr); + rhs_caf_attr = gfc_caf_attr (rhs_expr); + src_stat = dst_stat = null_pointer_node; + /* LHS. */ gfc_init_se (&lhs_se, NULL); if (lhs_expr->rank == 0) @@ -1264,6 +1879,22 @@ conv_caf_send (gfc_code *code) { lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr, attr); lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr); } + else if ((lhs_caf_attr.alloc_comp || lhs_caf_attr.pointer_comp) + && lhs_caf_attr.codimension) + { + lhs_se.want_pointer = 1; + gfc_conv_expr_descriptor (&lhs_se, lhs_expr); + /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that + has the wrong type if component references are done. */ + lhs_type = gfc_typenode_for_spec (&lhs_expr->ts); + tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr); + gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp), + gfc_get_dtype_rank_type ( + gfc_has_vector_subscript (lhs_expr) + ? gfc_find_array_ref (lhs_expr)->dimen + : lhs_expr->rank, + lhs_type)); + } else { /* If has_vector, pass descriptor for whole array and the @@ -1298,29 +1929,65 @@ conv_caf_send (gfc_code *code) { } lhs_kind = build_int_cst (integer_type_node, lhs_expr->ts.kind); - gfc_add_block_to_block (&block, &lhs_se.pre); /* Special case: RHS is a coarray but LHS is not; this code path avoids a temporary and a loop. */ - if (!gfc_is_coindexed (lhs_expr)) + if (!gfc_is_coindexed (lhs_expr) + && (!lhs_caf_attr.codimension + || !(lhs_expr->rank > 0 + && (lhs_caf_attr.allocatable || lhs_caf_attr.pointer)))) { + bool lhs_may_realloc = lhs_expr->rank > 0 && lhs_caf_attr.allocatable; gcc_assert (gfc_is_coindexed (rhs_expr)); gfc_init_se (&rhs_se, NULL); + if (lhs_expr->rank == 0 && lhs_caf_attr.allocatable) + { + gfc_se scal_se; + gfc_init_se (&scal_se, NULL); + scal_se.want_pointer = 1; + gfc_conv_expr (&scal_se, lhs_expr); + /* Ensure scalar on lhs is allocated. */ + gfc_add_block_to_block (&block, &scal_se.pre); + + gfc_allocate_using_malloc (&scal_se.pre, scal_se.expr, + TYPE_SIZE_UNIT ( + gfc_typenode_for_spec (&lhs_expr->ts)), + NULL_TREE); + tmp = fold_build2 (EQ_EXPR, boolean_type_node, scal_se.expr, + null_pointer_node); + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, + tmp, gfc_finish_block (&scal_se.pre), + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&block, tmp); + } + else + lhs_may_realloc = lhs_may_realloc + && gfc_full_array_ref_p (lhs_expr->ref, NULL); + gfc_add_block_to_block (&block, &lhs_se.pre); gfc_conv_intrinsic_caf_get (&rhs_se, rhs_expr, lhs_se.expr, lhs_kind, - may_require_tmp); + may_require_tmp, lhs_may_realloc, + &rhs_caf_attr); gfc_add_block_to_block (&block, &rhs_se.pre); gfc_add_block_to_block (&block, &rhs_se.post); gfc_add_block_to_block (&block, &lhs_se.post); return gfc_finish_block (&block); } - /* Obtain token, offset and image index for the LHS. */ + gfc_add_block_to_block (&block, &lhs_se.pre); + /* Obtain token, offset and image index for the LHS. */ caf_decl = gfc_get_tree_for_caf_expr (lhs_expr); if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE) caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl); image_index = gfc_caf_get_image_index (&block, lhs_expr, caf_decl); - gfc_get_caf_token_offset (&token, &offset, caf_decl, lhs_se.expr, lhs_expr); + tmp = lhs_se.expr; + if (lhs_caf_attr.alloc_comp) + gfc_get_caf_token_offset (&lhs_se, &token, NULL, caf_decl, NULL_TREE, + NULL); + else + gfc_get_caf_token_offset (&lhs_se, &token, &offset, caf_decl, tmp, + lhs_expr); + lhs_se.expr = tmp; /* RHS. */ gfc_init_se (&rhs_se, NULL); @@ -1332,11 +1999,26 @@ conv_caf_send (gfc_code *code) { symbol_attribute attr; gfc_clear_attr (&attr); gfc_conv_expr (&rhs_se, rhs_expr); - if (!gfc_is_coindexed (rhs_expr) && rhs_expr->ts.type != BT_CHARACTER) - rhs_se.expr = fold_convert (lhs_type , rhs_se.expr); rhs_se.expr = gfc_conv_scalar_to_descriptor (&rhs_se, rhs_se.expr, attr); rhs_se.expr = gfc_build_addr_expr (NULL_TREE, rhs_se.expr); } + else if ((rhs_caf_attr.alloc_comp || rhs_caf_attr.pointer_comp) + && rhs_caf_attr.codimension) + { + tree tmp2; + rhs_se.want_pointer = 1; + gfc_conv_expr_descriptor (&rhs_se, rhs_expr); + /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that + has the wrong type if component references are done. */ + tmp2 = gfc_typenode_for_spec (&rhs_expr->ts); + tmp = build_fold_indirect_ref_loc (input_location, rhs_se.expr); + gfc_add_modify (&rhs_se.pre, gfc_conv_descriptor_dtype (tmp), + gfc_get_dtype_rank_type ( + gfc_has_vector_subscript (rhs_expr) + ? gfc_find_array_ref (rhs_expr)->dimen + : rhs_expr->rank, + tmp2)); + } else { /* If has_vector, pass descriptor for whole array and the @@ -1375,17 +2057,45 @@ conv_caf_send (gfc_code *code) { rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind); + tmp_stat = gfc_find_stat_co (lhs_expr); + + if (tmp_stat) + { + gfc_se stat_se; + gfc_init_se (&stat_se, NULL); + gfc_conv_expr_reference (&stat_se, tmp_stat); + dst_stat = stat_se.expr; + gfc_add_block_to_block (&block, &stat_se.pre); + gfc_add_block_to_block (&block, &stat_se.post); + } + if (!gfc_is_coindexed (rhs_expr)) - tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9, token, - offset, image_index, lhs_se.expr, vec, - rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp); + { + if (lhs_caf_attr.alloc_comp || lhs_caf_attr.pointer_comp) + { + tree reference, dst_realloc; + reference = conv_expr_ref_to_caf_ref (&block, lhs_expr); + dst_realloc = lhs_caf_attr.allocatable ? boolean_true_node + : boolean_false_node; + tmp = build_call_expr_loc (input_location, + gfor_fndecl_caf_send_by_ref, + 9, token, image_index, rhs_se.expr, + reference, lhs_kind, rhs_kind, + may_require_tmp, dst_realloc, src_stat); + } + else + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10, + token, offset, image_index, lhs_se.expr, vec, + rhs_se.expr, lhs_kind, rhs_kind, + may_require_tmp, src_stat); + } else { tree rhs_token, rhs_offset, rhs_image_index; - /* It guarantees memory consistency within the same segment */ - tmp = gfc_build_string_const (strlen ("memory")+1, "memory"), - tmp = build5_loc (input_location, ASM_EXPR, void_type_node, + /* It guarantees memory consistency within the same segment. */ + tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"); + tmp = build5_loc (input_location, ASM_EXPR, void_type_node, gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE, tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE); ASM_VOLATILE_P (tmp) = 1; @@ -1395,20 +2105,50 @@ conv_caf_send (gfc_code *code) { if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE) caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl); rhs_image_index = gfc_caf_get_image_index (&block, rhs_expr, caf_decl); - gfc_get_caf_token_offset (&rhs_token, &rhs_offset, caf_decl, rhs_se.expr, - rhs_expr); - tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sendget, 13, - token, offset, image_index, lhs_se.expr, vec, - rhs_token, rhs_offset, rhs_image_index, - rhs_se.expr, rhs_vec, lhs_kind, rhs_kind, - may_require_tmp); + tmp = rhs_se.expr; + if (rhs_caf_attr.alloc_comp || rhs_caf_attr.pointer_comp) + { + tmp_stat = gfc_find_stat_co (lhs_expr); + + if (tmp_stat) + { + gfc_se stat_se; + gfc_init_se (&stat_se, NULL); + gfc_conv_expr_reference (&stat_se, tmp_stat); + src_stat = stat_se.expr; + gfc_add_block_to_block (&block, &stat_se.pre); + gfc_add_block_to_block (&block, &stat_se.post); + } + + gfc_get_caf_token_offset (&rhs_se, &rhs_token, NULL, caf_decl, + NULL_TREE, NULL); + tree lhs_reference, rhs_reference; + lhs_reference = conv_expr_ref_to_caf_ref (&block, lhs_expr); + rhs_reference = conv_expr_ref_to_caf_ref (&block, rhs_expr); + tmp = build_call_expr_loc (input_location, + gfor_fndecl_caf_sendget_by_ref, 11, + token, image_index, lhs_reference, + rhs_token, rhs_image_index, rhs_reference, + lhs_kind, rhs_kind, may_require_tmp, + dst_stat, src_stat); + } + else + { + gfc_get_caf_token_offset (&rhs_se, &rhs_token, &rhs_offset, caf_decl, + tmp, rhs_expr); + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sendget, + 14, token, offset, image_index, + lhs_se.expr, vec, rhs_token, rhs_offset, + rhs_image_index, tmp, rhs_vec, lhs_kind, + rhs_kind, may_require_tmp, src_stat); + } } gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&block, &lhs_se.post); gfc_add_block_to_block (&block, &rhs_se.post); - /* It guarantees memory consistency within the same segment */ - tmp = gfc_build_string_const (strlen ("memory")+1, "memory"), + /* It guarantees memory consistency within the same segment. */ + tmp = gfc_build_string_const (strlen ("memory") + 1, "memory"); tmp = build5_loc (input_location, ASM_EXPR, void_type_node, gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE, tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE); @@ -1648,6 +2388,42 @@ trans_this_image (gfc_se * se, gfc_expr *expr) } +/* Convert a call to image_status. */ + +static void +conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr) +{ + unsigned int num_args; + tree *args, tmp; + + num_args = gfc_intrinsic_argument_list_length (expr); + args = XALLOCAVEC (tree, num_args); + gfc_conv_intrinsic_function_args (se, expr, args, num_args); + /* In args[0] the number of the image the status is desired for has to be + given. */ + + if (flag_coarray == GFC_FCOARRAY_SINGLE) + { + tree arg; + arg = gfc_evaluate_now (args[0], &se->pre); + tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + fold_convert (integer_type_node, arg), + integer_one_node); + tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, + tmp, integer_zero_node, + build_int_cst (integer_type_node, + GFC_STAT_STOPPED_IMAGE)); + } + else if (flag_coarray == GFC_FCOARRAY_LIB) + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2, + args[0], build_int_cst (integer_type_node, -1)); + else + gcc_unreachable (); + + se->expr = tmp; +} + + static void trans_image_index (gfc_se * se, gfc_expr *expr) { @@ -2923,7 +3699,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op) if (TREE_TYPE (args[0]) != type) args[0] = convert (type, args[0]); /* Only evaluate the argument once. */ - if (TREE_CODE (args[0]) != VAR_DECL && !TREE_CONSTANT (args[0])) + if (!VAR_P (args[0]) && !TREE_CONSTANT (args[0])) args[0] = gfc_evaluate_now (args[0], &se->pre); mvar = gfc_create_var (type, "M"); @@ -2947,7 +3723,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op) cond = NULL_TREE; /* Only evaluate the argument once. */ - if (TREE_CODE (val) != VAR_DECL && !TREE_CONSTANT (val)) + if (!VAR_P (val) && !TREE_CONSTANT (val)) val = gfc_evaluate_now (val, &se->pre); } @@ -5299,7 +6075,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr) break; } - /* Otherwise fall through. */ + /* Fall through. */ default: /* Anybody stupid enough to do this deserves inefficient code. */ @@ -5815,9 +6591,20 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) if (actual->expr->ts.type == BT_CLASS) gfc_add_class_array_ref (actual->expr); - argse.want_pointer = 1; argse.data_not_needed = 1; - gfc_conv_expr_descriptor (&argse, actual->expr); + if (gfc_is_alloc_class_array_function (actual->expr)) + { + /* For functions that return a class array conv_expr_descriptor is not + able to get the descriptor right. Therefore this special case. */ + gfc_conv_expr_reference (&argse, actual->expr); + argse.expr = gfc_build_addr_expr (NULL_TREE, + gfc_class_data_get (argse.expr)); + } + else + { + argse.want_pointer = 1; + gfc_conv_expr_descriptor (&argse, actual->expr); + } gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); arg1 = gfc_evaluate_now (argse.expr, &se->pre); @@ -5967,7 +6754,9 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) TREE_OPERAND (argse.expr, 0), 0))) || GFC_DECL_CLASS (TREE_OPERAND (argse.expr, 0))))) byte_size = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0)); - else if (arg->rank > 0) + else if (arg->rank > 0 + || (arg->rank == 0 + && arg->ref && arg->ref->type == REF_COMPONENT)) /* The scalarizer added an additional temp. To get the class' vptr one has to look at the original backend_decl. */ byte_size = gfc_class_vtab_size_get ( @@ -6575,6 +7364,42 @@ scalar_transfer: } +/* Generate a call to caf_is_present. */ + +static tree +trans_caf_is_present (gfc_se *se, gfc_expr *expr) +{ + tree caf_reference, caf_decl, token, image_index; + + /* Compile the reference chain. */ + caf_reference = conv_expr_ref_to_caf_ref (&se->pre, expr); + gcc_assert (caf_reference != NULL_TREE); + + caf_decl = gfc_get_tree_for_caf_expr (expr); + if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE) + caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl); + image_index = gfc_caf_get_image_index (&se->pre, expr, caf_decl); + gfc_get_caf_token_offset (se, &token, NULL, caf_decl, NULL, + expr); + + return build_call_expr_loc (input_location, gfor_fndecl_caf_is_present, + 3, token, image_index, caf_reference); +} + + +/* Test whether this ref-chain refs this image only. */ + +static bool +caf_this_image_ref (gfc_ref *ref) +{ + for ( ; ref; ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.codimen) + return ref->u.ar.dimen_type[ref->u.ar.dimen] == DIMEN_THIS_IMAGE; + + return false; +} + + /* Generate code for the ALLOCATED intrinsic. Generate inline code that directly check the address of the argument. */ @@ -6584,6 +7409,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr) gfc_actual_arglist *arg1; gfc_se arg1se; tree tmp; + symbol_attribute caf_attr; gfc_init_se (&arg1se, NULL); arg1 = expr->value.function.actual; @@ -6599,23 +7425,37 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr) gfc_add_data_component (arg1->expr); } - if (arg1->expr->rank == 0) - { - /* Allocatable scalar. */ - arg1se.want_pointer = 1; - gfc_conv_expr (&arg1se, arg1->expr); - tmp = arg1se.expr; - } + /* When arg1 references an allocatable component in a coarray, then call + the caf-library function caf_is_present (). */ + if (flag_coarray == GFC_FCOARRAY_LIB && arg1->expr->expr_type == EXPR_FUNCTION + && arg1->expr->value.function.isym + && arg1->expr->value.function.isym->id == GFC_ISYM_CAF_GET) + caf_attr = gfc_caf_attr (arg1->expr->value.function.actual->expr); + else + gfc_clear_attr (&caf_attr); + if (flag_coarray == GFC_FCOARRAY_LIB && caf_attr.codimension + && !caf_this_image_ref (arg1->expr->value.function.actual->expr->ref)) + tmp = trans_caf_is_present (se, arg1->expr->value.function.actual->expr); else { - /* Allocatable array. */ - arg1se.descriptor_only = 1; - gfc_conv_expr_descriptor (&arg1se, arg1->expr); - tmp = gfc_conv_descriptor_data_get (arg1se.expr); - } + if (arg1->expr->rank == 0) + { + /* Allocatable scalar. */ + arg1se.want_pointer = 1; + gfc_conv_expr (&arg1se, arg1->expr); + tmp = arg1se.expr; + } + else + { + /* Allocatable array. */ + arg1se.descriptor_only = 1; + gfc_conv_expr_descriptor (&arg1se, arg1->expr); + tmp = gfc_conv_descriptor_data_get (arg1se.expr); + } - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp, - fold_convert (TREE_TYPE (tmp), null_pointer_node)); + tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp, + fold_convert (TREE_TYPE (tmp), null_pointer_node)); + } se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); } @@ -7137,7 +7977,7 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr) if (arg_expr->rank == 0) { if (arg_expr->ts.type == BT_CLASS) - gfc_add_component_ref (arg_expr, "_data"); + gfc_add_data_component (arg_expr); gfc_conv_expr_reference (se, arg_expr); } else @@ -7932,7 +8772,8 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) break; case GFC_ISYM_CAF_GET: - gfc_conv_intrinsic_caf_get (se, expr, NULL_TREE, NULL_TREE, NULL_TREE); + gfc_conv_intrinsic_caf_get (se, expr, NULL_TREE, NULL_TREE, NULL_TREE, + false, NULL); break; case GFC_ISYM_CMPLX: @@ -8303,6 +9144,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) trans_image_index (se, expr); break; + case GFC_ISYM_IMAGE_STATUS: + conv_intrinsic_image_status (se, expr); + break; + case GFC_ISYM_NUM_IMAGES: trans_num_images (se, expr); break; @@ -8653,10 +9498,12 @@ gfc_is_intrinsic_libcall (gfc_expr * expr) /* Ignore absent optional parameters. */ return 1; - case GFC_ISYM_RESHAPE: case GFC_ISYM_CSHIFT: case GFC_ISYM_EOSHIFT: + case GFC_ISYM_FAILED_IMAGES: + case GFC_ISYM_STOPPED_IMAGES: case GFC_ISYM_PACK: + case GFC_ISYM_RESHAPE: case GFC_ISYM_UNPACK: /* Pass absent optional parameters. */ return 2; @@ -9003,8 +9850,11 @@ conv_intrinsic_atomic_op (gfc_code *code) value = gfc_build_addr_expr (NULL_TREE, tmp); } - gfc_get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr); + gfc_init_se (&argse, NULL); + gfc_get_caf_token_offset (&argse, &token, &offset, caf_decl, atom, + atom_expr); + gfc_add_block_to_block (&block, &argse.pre); if (code->resolved_isym->id == GFC_ISYM_ATOMIC_DEF) tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_atomic_def, 7, token, offset, image_index, value, stat, @@ -9022,6 +9872,7 @@ conv_intrinsic_atomic_op (gfc_code *code) (int) atom_expr->ts.kind)); gfc_add_expr_to_block (&block, tmp); + gfc_add_block_to_block (&block, &argse.post); gfc_add_block_to_block (&block, &post_block); return gfc_finish_block (&block); } @@ -9149,7 +10000,10 @@ conv_intrinsic_atomic_ref (gfc_code *code) else image_index = integer_zero_node; - gfc_get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr); + gfc_init_se (&argse, NULL); + gfc_get_caf_token_offset (&argse, &token, &offset, caf_decl, atom, + atom_expr); + gfc_add_block_to_block (&block, &argse.pre); /* Different type, need type conversion. */ if (!POINTER_TYPE_P (TREE_TYPE (value))) @@ -9169,6 +10023,7 @@ conv_intrinsic_atomic_ref (gfc_code *code) if (vardecl != NULL_TREE) gfc_add_modify (&block, orig_value, fold_convert (TREE_TYPE (orig_value), vardecl)); + gfc_add_block_to_block (&block, &argse.post); gfc_add_block_to_block (&block, &post_block); return gfc_finish_block (&block); } @@ -9282,7 +10137,10 @@ conv_intrinsic_atomic_cas (gfc_code *code) comp = gfc_build_addr_expr (NULL_TREE, tmp); } - gfc_get_caf_token_offset (&token, &offset, caf_decl, atom, atom_expr); + gfc_init_se (&argse, NULL); + gfc_get_caf_token_offset (&argse, &token, &offset, caf_decl, atom, + atom_expr); + gfc_add_block_to_block (&block, &argse.pre); tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_atomic_cas, 9, token, offset, image_index, old, comp, new_val, @@ -9291,6 +10149,7 @@ conv_intrinsic_atomic_cas (gfc_code *code) build_int_cst (integer_type_node, (int) atom_expr->ts.kind)); gfc_add_expr_to_block (&block, tmp); + gfc_add_block_to_block (&block, &argse.post); gfc_add_block_to_block (&block, &post_block); return gfc_finish_block (&block); } @@ -9370,14 +10229,15 @@ conv_intrinsic_event_query (gfc_code *code) if (gfc_is_coindexed (event_expr)) { - gfc_error ("The event variable at %L shall not be coindexed ", + gfc_error ("The event variable at %L shall not be coindexed", &event_expr->where); return NULL_TREE; } image_index = integer_zero_node; - gfc_get_caf_token_offset (&token, NULL, caf_decl, NULL_TREE, event_expr); + gfc_get_caf_token_offset (&se, &token, NULL, caf_decl, NULL_TREE, + event_expr); /* For arrays, obtain the array index. */ if (gfc_expr_attr (event_expr).dimension) @@ -9513,8 +10373,8 @@ conv_intrinsic_move_alloc (gfc_code *code) gfc_add_block_to_block (&block, &to_se.pre); /* Deallocate "to". */ - tmp = gfc_deallocate_scalar_with_status (to_se.expr, NULL_TREE, true, - to_expr, to_expr->ts); + tmp = gfc_deallocate_scalar_with_status (to_se.expr, NULL_TREE, NULL_TREE, + true, to_expr, to_expr->ts); gfc_add_expr_to_block (&block, tmp); /* Assign (_data) pointers. */ @@ -9672,7 +10532,7 @@ conv_intrinsic_move_alloc (gfc_code *code) tmp = gfc_deallocate_with_status (to_se.expr, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, true, to_expr, - true); + GFC_CAF_COARRAY_DEALLOCATE_ONLY); gfc_add_expr_to_block (&block, tmp); tmp = gfc_conv_descriptor_data_get (to_se.expr); @@ -9700,7 +10560,8 @@ conv_intrinsic_move_alloc (gfc_code *code) tmp = gfc_conv_descriptor_data_get (to_se.expr); tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE, - NULL_TREE, true, to_expr, false); + NULL_TREE, true, to_expr, + GFC_CAF_COARRAY_NOCOARRAY); gfc_add_expr_to_block (&block, tmp); } diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 125f45ceb2..1b70136f49 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1,5 +1,5 @@ /* IO Code translation/library interface - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -32,6 +32,7 @@ along with GCC; see the file COPYING3. If not see #include "trans-array.h" #include "trans-types.h" #include "trans-const.h" +#include "options.h" /* Members of the ioparm structure. */ @@ -132,6 +133,7 @@ enum iocall IOCALL_X_COMPLEX128_WRITE, IOCALL_X_ARRAY, IOCALL_X_ARRAY_WRITE, + IOCALL_X_DERIVED, IOCALL_OPEN, IOCALL_CLOSE, IOCALL_INQUIRE, @@ -142,6 +144,7 @@ enum iocall IOCALL_ENDFILE, IOCALL_FLUSH, IOCALL_SET_NML_VAL, + IOCALL_SET_NML_DTIO_VAL, IOCALL_SET_NML_VAL_DIM, IOCALL_WAIT, IOCALL_NUM @@ -217,7 +220,12 @@ gfc_build_st_parameter (enum ioparam_type ptype, tree *types) gcc_unreachable (); } + /* -Wpadded warnings on these artificially created structures are not + helpful; suppress them. */ + int save_warn_padded = warn_padded; + warn_padded = 0; gfc_finish_type (t); + warn_padded = save_warn_padded; st_parameter[ptype].type = t; } @@ -309,8 +317,8 @@ gfc_build_io_library_fndecls (void) alignment that is at least as large as the needed alignment for those types. See the st_parameter_dt structure in libgfortran/io/io.h for what really goes into this space. */ - TYPE_ALIGN (types[IOPARM_type_pad]) = MAX (TYPE_ALIGN (pchar_type_node), - TYPE_ALIGN (gfc_get_int_type (gfc_intio_kind))); + SET_TYPE_ALIGN (types[IOPARM_type_pad], MAX (TYPE_ALIGN (pchar_type_node), + TYPE_ALIGN (gfc_get_int_type (gfc_intio_kind)))); for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++) gfc_build_st_parameter ((enum ioparam_type) ptype, types); @@ -397,6 +405,10 @@ gfc_build_io_library_fndecls (void) void_type_node, 4, dt_parm_type, pvoid_type_node, integer_type_node, gfc_charlen_type_node); + iocall[IOCALL_X_DERIVED] = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("transfer_derived")), ".wrR", + void_type_node, 2, dt_parm_type, pvoid_type_node, pchar_type_node); + /* Library entry points */ iocall[IOCALL_READ] = gfc_build_library_function_decl_with_spec ( @@ -468,6 +480,12 @@ gfc_build_io_library_fndecls (void) void_type_node, 6, dt_parm_type, pvoid_type_node, pvoid_type_node, gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node); + iocall[IOCALL_SET_NML_DTIO_VAL] = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("st_set_nml_dtio_var")), ".w.R", + void_type_node, 8, dt_parm_type, pvoid_type_node, pvoid_type_node, + gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node, + pvoid_type_node, pvoid_type_node); + iocall[IOCALL_SET_NML_VAL_DIM] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("st_set_nml_var_dim")), ".w", void_type_node, 5, dt_parm_type, gfc_int4_type_node, @@ -475,12 +493,8 @@ gfc_build_io_library_fndecls (void) } -/* Generate code to store an integer constant into the - st_parameter_XXX structure. */ - -static unsigned int -set_parameter_const (stmtblock_t *block, tree var, enum iofield type, - unsigned int val) +static void +set_parameter_tree (stmtblock_t *block, tree var, enum iofield type, tree value) { tree tmp; gfc_st_parameter_field *p = &st_parameter_field[type]; @@ -491,7 +505,21 @@ set_parameter_const (stmtblock_t *block, tree var, enum iofield type, var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field), var, p->field, NULL_TREE); - gfc_add_modify (block, tmp, build_int_cst (TREE_TYPE (p->field), val)); + gfc_add_modify (block, tmp, value); +} + + +/* Generate code to store an integer constant into the + st_parameter_XXX structure. */ + +static unsigned int +set_parameter_const (stmtblock_t *block, tree var, enum iofield type, + unsigned int val) +{ + gfc_st_parameter_field *p = &st_parameter_field[type]; + + set_parameter_tree (block, var, type, + build_int_cst (TREE_TYPE (p->field), val)); return p->mask; } @@ -637,7 +665,7 @@ set_parameter_value_inquire (stmtblock_t *block, tree var, body = gfc_finish_block (&newblock); - cond3 = gfc_unlikely (cond3, PRED_FORTRAN_FAIL_IO); + cond3 = gfc_unlikely (cond3, PRED_FORTRAN_FAIL_IO); var = build3_v (COND_EXPR, cond3, body, build_empty_stmt (input_location)); gfc_add_expr_to_block (&se.pre, var); } @@ -697,13 +725,7 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock, gfc_add_modify (postblock, se.expr, tmp); } - if (p->param_type == IOPARM_ptype_common) - var = fold_build3_loc (input_location, COMPONENT_REF, - st_parameter[IOPARM_ptype_common].type, - var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); - tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field), - var, p->field, NULL_TREE); - gfc_add_modify (block, tmp, addr); + set_parameter_tree (block, var, type, addr); return p->mask; } @@ -1107,6 +1129,14 @@ gfc_trans_open (gfc_code * code) mask |= set_parameter_ref (&block, &post_block, var, IOPARM_open_newunit, p->newunit); + if (p->cc) + mask |= set_string (&block, &post_block, var, IOPARM_open_cc, p->cc); + + if (p->share) + mask |= set_string (&block, &post_block, var, IOPARM_open_share, p->share); + + mask |= set_parameter_const (&block, var, IOPARM_open_readonly, p->readonly); + set_parameter_const (&block, var, IOPARM_common_flags, mask); if (p->unit) @@ -1434,6 +1464,13 @@ gfc_trans_inquire (gfc_code * code) mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_iqstream, p->iqstream); + if (p->share) + mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_share, + p->share); + + if (p->cc) + mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_cc, p->cc); + if (mask2) mask |= set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2); @@ -1557,10 +1594,10 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c, else decl = c->backend_decl; - gcc_assert (decl && ((TREE_CODE (decl) == FIELD_DECL - || TREE_CODE (decl) == VAR_DECL - || TREE_CODE (decl) == PARM_DECL) - || TREE_CODE (decl) == COMPONENT_REF)); + gcc_assert (decl && (TREE_CODE (decl) == FIELD_DECL + || VAR_P (decl) + || TREE_CODE (decl) == PARM_DECL + || TREE_CODE (decl) == COMPONENT_REF)); tmp = decl; @@ -1618,6 +1655,8 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, tree dt_parm_addr; tree decl = NULL_TREE; tree gfc_int4_type_node = gfc_get_int_type (4); + tree dtio_proc = null_pointer_node; + tree vtable = null_pointer_node; int n_dim; int itype; int rank = 0; @@ -1659,15 +1698,76 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm); + /* Check if the derived type has a specific DTIO for the mode. + Note that although namelist io is forbidden to have a format + list, the specific subroutine is of the formatted kind. */ + if (ts->type == BT_DERIVED || ts->type == BT_CLASS) + { + gfc_symbol *derived; + if (ts->type==BT_CLASS) + derived = ts->u.derived->components->ts.u.derived; + else + derived = ts->u.derived; + + gfc_symtree *tb_io_st = gfc_find_typebound_dtio_proc (derived, + last_dt == WRITE, true); + + if (ts->type == BT_CLASS && tb_io_st) + { + // polymorphic DTIO call (based on the dynamic type) + gfc_se se; + gfc_symtree *st = gfc_find_symtree (sym->ns->sym_root, sym->name); + // build vtable expr + gfc_expr *expr = gfc_get_variable_expr (st); + gfc_add_vptr_component (expr); + gfc_init_se (&se, NULL); + se.want_pointer = 1; + gfc_conv_expr (&se, expr); + vtable = se.expr; + // build dtio expr + gfc_add_component_ref (expr, + tb_io_st->n.tb->u.generic->specific_st->name); + gfc_init_se (&se, NULL); + se.want_pointer = 1; + gfc_conv_expr (&se, expr); + gfc_free_expr (expr); + dtio_proc = se.expr; + } + else + { + // non-polymorphic DTIO call (based on the declared type) + gfc_symbol *dtio_sub = gfc_find_specific_dtio_proc (derived, + last_dt == WRITE, true); + if (dtio_sub != NULL) + { + dtio_proc = gfc_get_symbol_decl (dtio_sub); + dtio_proc = gfc_build_addr_expr (NULL, dtio_proc); + gfc_symbol *vtab = gfc_find_derived_vtab (derived); + vtable = vtab->backend_decl; + if (vtable == NULL_TREE) + vtable = gfc_get_symbol_decl (vtab); + vtable = gfc_build_addr_expr (pvoid_type_node, vtable); + } + } + } + if (ts->type == BT_CHARACTER) tmp = ts->u.cl->backend_decl; else tmp = build_int_cst (gfc_charlen_type_node, 0); - 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); + + if (dtio_proc == NULL_TREE) + 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); + 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); gfc_add_expr_to_block (block, tmp); /* If the object is an array, transfer rank times: @@ -1685,7 +1785,8 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, gfc_add_expr_to_block (block, tmp); } - if (gfc_bt_struct (ts->type) && ts->u.derived->components) + if (gfc_bt_struct (ts->type) && ts->u.derived->components + && dtio_proc == null_pointer_node) { gfc_component *cmp; @@ -1759,7 +1860,8 @@ build_dt (tree function, gfc_code * code) mask |= set_internal_unit (&block, &post_iu_block, var, dt->io_unit); set_parameter_const (&block, var, IOPARM_common_unit, - dt->io_unit->ts.kind == 1 ? 0 : -1); + dt->io_unit->ts.kind == 1 ? + GFC_INTERNAL_UNIT : GFC_INTERNAL_UNIT4); } } else @@ -1843,6 +1945,12 @@ build_dt (tree function, gfc_code * code) mask |= set_parameter_ref (&block, &post_end_block, var, IOPARM_dt_size, dt->size); + if (dt->udtio) + mask |= IOPARM_dt_dtio; + + if (dt->default_exp) + mask |= IOPARM_dt_default_exp; + if (dt->namelist) { if (dt->format_expr || dt->format_label) @@ -1995,7 +2103,8 @@ gfc_trans_dt_end (gfc_code * code) } static void -transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code); +transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, + gfc_code * code, tree vptr); /* Given an array field in a derived type variable, generate the code for the loop that iterates over array elements, and the code that @@ -2061,7 +2170,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) /* Now se.expr contains an element of the array. Take the address and pass it to the IO routines. */ tmp = gfc_build_addr_expr (NULL_TREE, se.expr); - transfer_expr (&se, &cm->ts, tmp, NULL); + transfer_expr (&se, &cm->ts, tmp, NULL, NULL_TREE); /* We are done now with the loop body. Wrap up the scalarizer and return. */ @@ -2081,10 +2190,73 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) return gfc_finish_block (&block); } + +/* Helper function for transfer_expr that looks for the DTIO procedure + either as a typebound binding or in a generic interface. If present, + the address expression of the procedure is returned. It is assumed + that the procedure interface has been checked during resolution. */ + +static tree +get_dtio_proc (gfc_typespec * ts, gfc_code * code, gfc_symbol **dtio_sub) +{ + gfc_symbol *derived; + bool formatted = false; + gfc_dt *dt = code->ext.dt; + + if (dt && dt->format_expr) + { + char *fmt; + fmt = gfc_widechar_to_char (dt->format_expr->value.character.string, + -1); + if (strtok (fmt, "DT") != NULL) + formatted = true; + } + else if (dt && dt->format_label == &format_asterisk) + { + /* List directed io must call the formatted DTIO procedure. */ + formatted = true; + } + + if (ts->type == BT_CLASS) + derived = ts->u.derived->components->ts.u.derived; + else + derived = ts->u.derived; + + gfc_symtree *tb_io_st = gfc_find_typebound_dtio_proc (derived, + last_dt == WRITE, formatted); + if (ts->type == BT_CLASS && tb_io_st) + { + // polymorphic DTIO call (based on the dynamic type) + gfc_se se; + gfc_expr *expr = gfc_find_and_cut_at_last_class_ref (code->expr1); + gfc_add_vptr_component (expr); + gfc_add_component_ref (expr, + tb_io_st->n.tb->u.generic->specific_st->name); + *dtio_sub = tb_io_st->n.tb->u.generic->specific->u.specific->n.sym; + gfc_init_se (&se, NULL); + se.want_pointer = 1; + gfc_conv_expr (&se, expr); + gfc_free_expr (expr); + return se.expr; + } + else + { + // non-polymorphic DTIO call (based on the declared type) + *dtio_sub = gfc_find_specific_dtio_proc (derived, last_dt == WRITE, + formatted); + + if (*dtio_sub) + return gfc_build_addr_expr (NULL, gfc_get_symbol_decl (*dtio_sub)); + } + + return NULL_TREE; +} + /* Generate the call for a scalar transfer node. */ static void -transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) +transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, + gfc_code * code, tree vptr) { tree tmp, function, arg2, arg3, field, expr; gfc_component *c; @@ -2212,43 +2384,82 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) break; case_bt_struct: + case BT_CLASS: if (ts->u.derived->components == NULL) return; + if (ts->type == BT_DERIVED || ts->type == BT_CLASS) + { + gfc_symbol *derived; + gfc_symbol *dtio_sub = NULL; + /* Test for a specific DTIO subroutine. */ + if (ts->type == BT_DERIVED) + derived = ts->u.derived; + else + derived = ts->u.derived->components->ts.u.derived; - /* Recurse into the elements of the derived type. */ - expr = gfc_evaluate_now (addr_expr, &se->pre); - expr = build_fold_indirect_ref_loc (input_location, - expr); + if (derived->attr.has_dtio_procs) + arg2 = get_dtio_proc (ts, code, &dtio_sub); - /* Make sure that the derived type has been built. An external - function, if only referenced in an io statement, requires this - check (see PR58771). */ - if (ts->u.derived->backend_decl == NULL_TREE) - (void) gfc_typenode_for_spec (ts); + if ((dtio_sub != NULL) && (last_dt != IOLENGTH)) + { + tree decl; + decl = build_fold_indirect_ref_loc (input_location, + se->expr); + /* Remember that the first dummy of the DTIO subroutines + is CLASS(derived) for extensible derived types, so the + conversion must be done here for derived type and for + scalarized CLASS array element io-list objects. */ + if ((ts->type == BT_DERIVED + && !(ts->u.derived->attr.sequence + || ts->u.derived->attr.is_bind_c)) + || (ts->type == BT_CLASS + && !GFC_CLASS_TYPE_P (TREE_TYPE (decl)))) + gfc_conv_derived_to_class (se, code->expr1, + dtio_sub->formal->sym->ts, + vptr, false, false); + addr_expr = se->expr; + function = iocall[IOCALL_X_DERIVED]; + break; + } + else if (ts->type == BT_DERIVED) + { + /* Recurse into the elements of the derived type. */ + expr = gfc_evaluate_now (addr_expr, &se->pre); + expr = build_fold_indirect_ref_loc (input_location, + expr); - for (c = ts->u.derived->components; c; c = c->next) - { - field = c->backend_decl; - gcc_assert (field && TREE_CODE (field) == FIELD_DECL); - - tmp = fold_build3_loc (UNKNOWN_LOCATION, - COMPONENT_REF, TREE_TYPE (field), - expr, field, NULL_TREE); - - if (c->attr.dimension) - { - tmp = transfer_array_component (tmp, c, & code->loc); - gfc_add_expr_to_block (&se->pre, tmp); - } - else - { - if (!c->attr.pointer) - tmp = gfc_build_addr_expr (NULL_TREE, tmp); - transfer_expr (se, &c->ts, tmp, code); - } + /* Make sure that the derived type has been built. An external + function, if only referenced in an io statement, requires this + check (see PR58771). */ + if (ts->u.derived->backend_decl == NULL_TREE) + (void) gfc_typenode_for_spec (ts); + + for (c = ts->u.derived->components; c; c = c->next) + { + field = c->backend_decl; + gcc_assert (field && TREE_CODE (field) == FIELD_DECL); + + tmp = fold_build3_loc (UNKNOWN_LOCATION, + COMPONENT_REF, TREE_TYPE (field), + expr, field, NULL_TREE); + + if (c->attr.dimension) + { + tmp = transfer_array_component (tmp, c, & code->loc); + gfc_add_expr_to_block (&se->pre, tmp); + } + else + { + if (!c->attr.pointer) + tmp = gfc_build_addr_expr (NULL_TREE, tmp); + transfer_expr (se, &c->ts, tmp, code, NULL_TREE); + } + } + return; + } + /* If a CLASS object gets through to here, fall through and ICE. */ } - return; - + gcc_fallthrough (); default: gfc_internal_error ("Bad IO basetype (%d)", ts->type); } @@ -2303,6 +2514,7 @@ gfc_trans_transfer (gfc_code * code) gfc_ss *ss; gfc_se se; tree tmp; + tree vptr; int n; gfc_start_block (&block); @@ -2315,8 +2527,18 @@ gfc_trans_transfer (gfc_code * code) if (expr->rank == 0) { /* Transfer a scalar value. */ - gfc_conv_expr_reference (&se, expr); - transfer_expr (&se, &expr->ts, se.expr, code); + if (expr->ts.type == BT_CLASS) + { + se.want_pointer = 1; + gfc_conv_expr (&se, expr); + vptr = gfc_get_vptr_from_expr (se.expr); + } + else + { + vptr = NULL_TREE; + gfc_conv_expr_reference (&se, expr); + } + transfer_expr (&se, &expr->ts, se.expr, code, vptr); } else { @@ -2330,7 +2552,8 @@ gfc_trans_transfer (gfc_code * code) gcc_assert (ref && ref->type == REF_ARRAY); } - if (!gfc_bt_struct (expr->ts.type) + if (!(gfc_bt_struct (expr->ts.type) + || expr->ts.type == BT_CLASS) && ref && ref->next == NULL && !is_subref_array (expr)) { @@ -2378,9 +2601,12 @@ gfc_trans_transfer (gfc_code * code) gfc_copy_loopinfo_to_se (&se, &loop); se.ss = ss; - gfc_conv_expr_reference (&se, expr); - transfer_expr (&se, &expr->ts, se.expr, code); + if (expr->ts.type == BT_CLASS) + vptr = gfc_get_vptr_from_expr (ss->info->data.array.descriptor); + else + vptr = NULL_TREE; + transfer_expr (&se, &expr->ts, se.expr, code, vptr); } finish_block_label: diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index b3baeeca57..662036f514 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1,5 +1,5 @@ /* OpenMP directive translation -- generate GCC trees from gfc_code. - Copyright (C) 2005-2016 Free Software Foundation, Inc. + Copyright (C) 2005-2017 Free Software Foundation, Inc. Contributed by Jakub Jelinek <jakub@redhat.com> This file is part of GCC. @@ -35,8 +35,14 @@ along with GCC; see the file COPYING3. If not see #include "trans-array.h" #include "trans-const.h" #include "arith.h" -#include "omp-low.h" #include "gomp-constants.h" +#include "omp-general.h" +#include "omp-low.h" +#undef GCC_DIAG_STYLE +#define GCC_DIAG_STYLE __gcc_tdiag__ +#include "diagnostic-core.h" +#undef GCC_DIAG_STYLE +#define GCC_DIAG_STYLE __gcc_gfc__ int ompws_flags; @@ -143,9 +149,7 @@ gfc_omp_predetermined_sharing (tree decl) variables at all (they can't be redefined), but they can nevertheless appear in parallel/task regions and for default(none) purposes treat them as shared. For vtables likely the same handling is desirable. */ - if (TREE_CODE (decl) == VAR_DECL - && TREE_READONLY (decl) - && TREE_STATIC (decl)) + if (VAR_P (decl) && TREE_READONLY (decl) && TREE_STATIC (decl)) return OMP_CLAUSE_DEFAULT_SHARED; return OMP_CLAUSE_DEFAULT_UNSPECIFIED; @@ -207,6 +211,9 @@ gfc_omp_private_outer_ref (tree decl) { tree type = TREE_TYPE (decl); + if (gfc_omp_privatize_by_reference (decl)) + type = TREE_TYPE (type); + if (GFC_DESCRIPTOR_TYPE_P (type) && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) return true; @@ -214,9 +221,6 @@ gfc_omp_private_outer_ref (tree decl) if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)) return true; - if (gfc_omp_privatize_by_reference (decl)) - type = TREE_TYPE (type); - if (gfc_has_alloc_comps (type, decl)) return true; @@ -422,8 +426,11 @@ gfc_walk_alloc_comps (tree decl, tree dest, tree var, if (GFC_DESCRIPTOR_TYPE_P (ftype) && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) { - tem = gfc_trans_dealloc_allocated (unshare_expr (declf), - false, NULL); + tem = gfc_conv_descriptor_data_get (unshare_expr (declf)); + tem = gfc_deallocate_with_status (tem, NULL_TREE, NULL_TREE, + NULL_TREE, NULL_TREE, true, + NULL, + GFC_CAF_COARRAY_NOCOARRAY); gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem)); } else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) @@ -812,9 +819,13 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) { gfc_init_block (&cond_block); if (GFC_DESCRIPTOR_TYPE_P (type)) - gfc_add_expr_to_block (&cond_block, - gfc_trans_dealloc_allocated (unshare_expr (dest), - false, NULL)); + { + tree tmp = gfc_conv_descriptor_data_get (unshare_expr (dest)); + tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, + NULL_TREE, NULL_TREE, true, NULL, + GFC_CAF_COARRAY_NOCOARRAY); + gfc_add_expr_to_block (&cond_block, tmp); + } else { destptr = gfc_evaluate_now (destptr, &cond_block); @@ -988,9 +999,14 @@ gfc_omp_clause_dtor (tree clause, tree decl) } if (GFC_DESCRIPTOR_TYPE_P (type)) - /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need - to be deallocated if they were allocated. */ - tem = gfc_trans_dealloc_allocated (decl, false, NULL); + { + /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need + to be deallocated if they were allocated. */ + tem = gfc_conv_descriptor_data_get (decl); + tem = gfc_deallocate_with_status (tem, NULL_TREE, NULL_TREE, NULL_TREE, + NULL_TREE, true, NULL, + GFC_CAF_COARRAY_NOCOARRAY); + } else tem = gfc_call_free (decl); tem = gfc_omp_unshare_expr (tem); @@ -1028,6 +1044,21 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) return; tree decl = OMP_CLAUSE_DECL (c); + + /* Assumed-size arrays can't be mapped implicitly, they have to be + mapped explicitly using array sections. */ + if (TREE_CODE (decl) == PARM_DECL + && GFC_ARRAY_TYPE_P (TREE_TYPE (decl)) + && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN + && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl), + GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1) + == NULL) + { + error_at (OMP_CLAUSE_LOCATION (c), + "implicit mapping of assumed size array %qD", decl); + return; + } + tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE; if (POINTER_TYPE_P (TREE_TYPE (decl))) { @@ -1142,6 +1173,34 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) } +/* Return true if DECL is a scalar variable (for the purpose of + implicit firstprivatization). */ + +bool +gfc_omp_scalar_p (tree decl) +{ + tree type = TREE_TYPE (decl); + if (TREE_CODE (type) == REFERENCE_TYPE) + type = TREE_TYPE (type); + if (TREE_CODE (type) == POINTER_TYPE) + { + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl) + || GFC_DECL_GET_SCALAR_POINTER (decl)) + type = TREE_TYPE (type); + if (GFC_ARRAY_TYPE_P (type) + || GFC_CLASS_TYPE_P (type)) + return false; + } + if (TYPE_STRING_FLAG (type)) + return false; + if (INTEGRAL_TYPE_P (type) + || SCALAR_FLOAT_TYPE_P (type) + || COMPLEX_FLOAT_TYPE_P (type)) + return true; + return false; +} + + /* Return true if DECL's DECL_VALUE_EXPR (if any) should be disregarded in OpenMP construct, because it is going to be remapped during OpenMP lowering. SHARED is true if DECL @@ -1156,7 +1215,7 @@ gfc_omp_disregard_value_expr (tree decl, bool shared) tree value = DECL_VALUE_EXPR (decl); if (TREE_CODE (value) == COMPONENT_REF - && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL + && VAR_P (TREE_OPERAND (value, 0)) && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0))) { /* If variable in COMMON or EQUIVALENCE is privatized, return @@ -1192,7 +1251,7 @@ gfc_omp_private_debug_clause (tree decl, bool shared) tree value = DECL_VALUE_EXPR (decl); if (TREE_CODE (value) == COMPONENT_REF - && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL + && VAR_P (TREE_OPERAND (value, 0)) && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0))) return shared; } @@ -1647,7 +1706,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) static tree gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list, - locus where) + locus where, bool mark_addressable) { for (; namelist != NULL; namelist = namelist->next) if (namelist->sym->attr.referenced) @@ -1658,6 +1717,8 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list, tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_REDUCTION); OMP_CLAUSE_DECL (node) = t; + if (mark_addressable) + TREE_ADDRESSABLE (t) = 1; switch (namelist->u.reduction_op) { case OMP_REDUCTION_PLUS: @@ -1727,12 +1788,14 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr) return result; } +static vec<tree, va_heap, vl_embed> *doacross_steps; + static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, locus where, bool declare_simd = false) { tree omp_clauses = NULL_TREE, chunk_size, c; - int list; + int list, ifc; enum omp_clause_code clause_code; gfc_se se; @@ -1748,7 +1811,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, switch (list) { case OMP_LIST_REDUCTION: - omp_clauses = gfc_trans_omp_reduction_list (n, omp_clauses, where); + /* An OpenACC async clause indicates the need to set reduction + arguments addressable, to allow asynchronous copy-out. */ + omp_clauses = gfc_trans_omp_reduction_list (n, omp_clauses, where, + clauses->async); break; case OMP_LIST_PRIVATE: clause_code = OMP_CLAUSE_PRIVATE; @@ -1772,10 +1838,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, clause_code = OMP_CLAUSE_UNIFORM; goto add_clause; case OMP_LIST_USE_DEVICE: + case OMP_LIST_USE_DEVICE_PTR: clause_code = OMP_CLAUSE_USE_DEVICE_PTR; goto add_clause; - case OMP_LIST_DEVICE_RESIDENT: - clause_code = OMP_CLAUSE_DEVICE_RESIDENT; + case OMP_LIST_IS_DEVICE_PTR: + clause_code = OMP_CLAUSE_IS_DEVICE_PTR; goto add_clause; add_clause: @@ -1797,7 +1864,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree alignment_var; - if (block == NULL) + if (declare_simd) alignment_var = gfc_conv_constant_to_tree (n->expr); else { @@ -1817,6 +1884,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { gfc_expr *last_step_expr = NULL; tree last_step = NULL_TREE; + bool last_step_parm = false; for (; n != NULL; n = n->next) { @@ -1824,6 +1892,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { last_step_expr = n->expr; last_step = NULL_TREE; + last_step_parm = false; } if (n->sym->attr.referenced || declare_simd) { @@ -1833,12 +1902,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tree node = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); OMP_CLAUSE_DECL (node) = t; + omp_clause_linear_kind kind; + switch (n->u.linear_op) + { + case OMP_LINEAR_DEFAULT: + kind = OMP_CLAUSE_LINEAR_DEFAULT; + break; + case OMP_LINEAR_REF: + kind = OMP_CLAUSE_LINEAR_REF; + break; + case OMP_LINEAR_VAL: + kind = OMP_CLAUSE_LINEAR_VAL; + break; + case OMP_LINEAR_UVAL: + kind = OMP_CLAUSE_LINEAR_UVAL; + break; + default: + gcc_unreachable (); + } + OMP_CLAUSE_LINEAR_KIND (node) = kind; if (last_step_expr && last_step == NULL_TREE) { - if (block == NULL) - last_step - = gfc_conv_constant_to_tree (last_step_expr); - else + if (!declare_simd) { gfc_init_se (&se, NULL); gfc_conv_expr (&se, last_step_expr); @@ -1846,10 +1931,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, last_step = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); } + else if (last_step_expr->expr_type == EXPR_VARIABLE) + { + gfc_symbol *s = last_step_expr->symtree->n.sym; + last_step = gfc_trans_omp_variable (s, true); + last_step_parm = true; + } + else + last_step + = gfc_conv_constant_to_tree (last_step_expr); + } + if (last_step_parm) + { + OMP_CLAUSE_LINEAR_VARIABLE_STRIDE (node) = 1; + OMP_CLAUSE_LINEAR_STEP (node) = last_step; + } + else + { + tree type = gfc_typenode_for_spec (&n->sym->ts); + OMP_CLAUSE_LINEAR_STEP (node) + = fold_convert (type, last_step); } - OMP_CLAUSE_LINEAR_STEP (node) - = fold_convert (gfc_typenode_for_spec (&n->sym->ts), - last_step); if (n->sym->attr.dimension || n->sym->attr.allocatable) OMP_CLAUSE_LINEAR_ARRAY (node) = 1; omp_clauses = gfc_trans_add_clause (node, omp_clauses); @@ -1861,6 +1963,57 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_DEPEND: for (; n != NULL; n = n->next) { + if (n->u.depend_op == OMP_DEPEND_SINK_FIRST) + { + tree vec = NULL_TREE; + unsigned int i; + for (i = 0; ; i++) + { + tree addend = integer_zero_node, t; + bool neg = false; + if (n->expr) + { + addend = gfc_conv_constant_to_tree (n->expr); + if (TREE_CODE (addend) == INTEGER_CST + && tree_int_cst_sgn (addend) == -1) + { + neg = true; + addend = const_unop (NEGATE_EXPR, + TREE_TYPE (addend), addend); + } + } + t = gfc_trans_omp_variable (n->sym, false); + if (t != error_mark_node) + { + if (i < vec_safe_length (doacross_steps) + && !integer_zerop (addend) + && (*doacross_steps)[i]) + { + tree step = (*doacross_steps)[i]; + addend = fold_convert (TREE_TYPE (step), addend); + addend = build2 (TRUNC_DIV_EXPR, + TREE_TYPE (step), addend, step); + } + vec = tree_cons (addend, t, vec); + if (neg) + OMP_CLAUSE_DEPEND_SINK_NEGATIVE (vec) = 1; + } + if (n->next == NULL + || n->next->u.depend_op != OMP_DEPEND_SINK) + break; + n = n->next; + } + if (vec == NULL_TREE) + continue; + + tree node = build_omp_clause (input_location, + OMP_CLAUSE_DEPEND); + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_SINK; + OMP_CLAUSE_DECL (node) = nreverse (vec); + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + continue; + } + if (!n->sym->attr.referenced) continue; @@ -2120,6 +2273,18 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_MAP_TOFROM: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM); break; + case OMP_MAP_ALWAYS_TO: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO); + break; + case OMP_MAP_ALWAYS_FROM: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_FROM); + break; + case OMP_MAP_ALWAYS_TOFROM: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TOFROM); + break; + case OMP_MAP_RELEASE: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_RELEASE); + break; case OMP_MAP_DELETE: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DELETE); break; @@ -2260,6 +2425,50 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_IF_EXPR (c) = if_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + for (ifc = 0; ifc < OMP_IF_LAST; ifc++) + if (clauses->if_exprs[ifc]) + { + tree if_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->if_exprs[ifc]); + gfc_add_block_to_block (block, &se.pre); + if_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF); + switch (ifc) + { + case OMP_IF_PARALLEL: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_PARALLEL; + break; + case OMP_IF_TASK: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASK; + break; + case OMP_IF_TASKLOOP: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASKLOOP; + break; + case OMP_IF_TARGET: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET; + break; + case OMP_IF_TARGET_DATA: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_DATA; + break; + case OMP_IF_TARGET_UPDATE: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_UPDATE; + break; + case OMP_IF_TARGET_ENTER_DATA: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_ENTER_DATA; + break; + case OMP_IF_TARGET_EXIT_DATA: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_EXIT_DATA; + break; + default: + gcc_unreachable (); + } + OMP_CLAUSE_IF_EXPR (c) = if_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } if (clauses->final_expr) { @@ -2325,6 +2534,16 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, default: gcc_unreachable (); } + if (clauses->sched_monotonic) + OMP_CLAUSE_SCHEDULE_KIND (c) + = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c) + | OMP_CLAUSE_SCHEDULE_MONOTONIC); + else if (clauses->sched_nonmonotonic) + OMP_CLAUSE_SCHEDULE_KIND (c) + = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c) + | OMP_CLAUSE_SCHEDULE_NONMONOTONIC); + if (clauses->sched_simd) + OMP_CLAUSE_SCHEDULE_SIMD (c) = 1; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2360,7 +2579,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->ordered) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED); - OMP_CLAUSE_ORDERED_EXPR (c) = NULL_TREE; + OMP_CLAUSE_ORDERED_EXPR (c) + = clauses->orderedc ? build_int_cst (integer_type_node, + clauses->orderedc) : NULL_TREE; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2455,10 +2676,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->simdlen_expr) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); - OMP_CLAUSE_SIMDLEN_EXPR (c) - = gfc_conv_constant_to_tree (clauses->simdlen_expr); - omp_clauses = gfc_trans_add_clause (c, omp_clauses); + if (declare_simd) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + OMP_CLAUSE_SIMDLEN_EXPR (c) + = gfc_conv_constant_to_tree (clauses->simdlen_expr); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + else + { + tree simdlen_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->simdlen_expr); + gfc_add_block_to_block (block, &se.pre); + simdlen_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } } if (clauses->num_teams) @@ -2523,6 +2761,93 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->grainsize) + { + tree grainsize; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->grainsize); + gfc_add_block_to_block (block, &se.pre); + grainsize = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_GRAINSIZE); + OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->num_tasks) + { + tree num_tasks; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->num_tasks); + gfc_add_block_to_block (block, &se.pre); + num_tasks = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TASKS); + OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->priority) + { + tree priority; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->priority); + gfc_add_block_to_block (block, &se.pre); + priority = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PRIORITY); + OMP_CLAUSE_PRIORITY_EXPR (c) = priority; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->hint) + { + tree hint; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->hint); + gfc_add_block_to_block (block, &se.pre); + hint = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_HINT); + OMP_CLAUSE_HINT_EXPR (c) = hint; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->simd) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMD); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->threads) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREADS); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->nogroup) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOGROUP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->defaultmap) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULTMAP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->depend_source) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEPEND); + OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->async) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC); @@ -2816,7 +3141,11 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_start_block (&block); expr2 = code->expr2; - if (expr2->expr_type == EXPR_FUNCTION + if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + != GFC_OMP_ATOMIC_WRITE) + && (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP) == 0 + && expr2->expr_type == EXPR_FUNCTION + && expr2->value.function.isym && expr2->value.function.isym->id == GFC_ISYM_CONVERSION) expr2 = expr2->value.function.actual->expr; @@ -2855,6 +3184,7 @@ gfc_trans_omp_atomic (gfc_code *code) 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; } @@ -2912,6 +3242,7 @@ gfc_trans_omp_atomic (gfc_code *code) } e = expr2->value.op.op1; if (e->expr_type == EXPR_FUNCTION + && e->value.function.isym && e->value.function.isym->id == GFC_ISYM_CONVERSION) e = e->value.function.actual->expr; if (e->expr_type == EXPR_VARIABLE @@ -2925,6 +3256,7 @@ gfc_trans_omp_atomic (gfc_code *code) { e = expr2->value.op.op2; 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 @@ -2992,7 +3324,7 @@ gfc_trans_omp_atomic (gfc_code *code) lhsaddr = save_expr (lhsaddr); if (TREE_CODE (lhsaddr) != SAVE_EXPR && (TREE_CODE (lhsaddr) != ADDR_EXPR - || TREE_CODE (TREE_OPERAND (lhsaddr, 0)) != VAR_DECL)) + || !VAR_P (TREE_OPERAND (lhsaddr, 0)))) { /* Make sure LHS is simple enough so that goa_lhs_expr_p can recognize it even after unsharing function body. */ @@ -3039,6 +3371,7 @@ gfc_trans_omp_atomic (gfc_code *code) 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; @@ -3127,8 +3460,8 @@ static tree gfc_trans_omp_critical (gfc_code *code) { tree name = NULL_TREE, stmt; - if (code->ext.omp_name != NULL) - name = get_identifier (code->ext.omp_name); + if (code->ext.omp_clauses != NULL) + name = get_identifier (code->ext.omp_clauses->critical_name); stmt = gfc_trans_code (code->block->next); return build3_loc (input_location, OMP_CRITICAL, void_type_node, stmt, NULL_TREE, name); @@ -3145,7 +3478,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, gfc_omp_clauses *do_clauses, tree par_clauses) { gfc_se se; - tree dovar, stmt, from, to, step, type, init, cond, incr; + tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls; tree count = NULL_TREE, cycle_label, tmp, omp_clauses; stmtblock_t block; stmtblock_t body; @@ -3154,7 +3487,22 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, vec<dovar_init> inits = vNULL; dovar_init *di; unsigned ix; + vec<tree, va_heap, vl_embed> *saved_doacross_steps = doacross_steps; + gfc_expr_list *tile = do_clauses ? do_clauses->tile_list : clauses->tile_list; + + /* Both collapsed and tiled loops are lowered the same way. In + OpenACC, those clauses are not compatible, so prioritize the tile + clause, if present. */ + if (tile) + { + collapse = 0; + for (gfc_expr_list *el = tile; el; el = el->next) + collapse++; + } + doacross_steps = NULL; + if (clauses->orderedc) + collapse = clauses->orderedc; if (collapse <= 0) collapse = 1; @@ -3164,6 +3512,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, init = make_tree_vec (collapse); cond = make_tree_vec (collapse); incr = make_tree_vec (collapse); + orig_decls = clauses->orderedc ? make_tree_vec (collapse) : NULL_TREE; if (pblock == NULL) { @@ -3171,6 +3520,11 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, pblock = █ } + /* simd schedule modifier is only useful for composite do simd and other + constructs including that, where gfc_trans_omp_do is only called + on the simd construct and DO's clauses are translated elsewhere. */ + do_clauses->sched_simd = false; + omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc); for (i = 0; i < collapse; i++) @@ -3223,7 +3577,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, dovar_decl = dovar; /* Special case simple loops. */ - if (TREE_CODE (dovar) == VAR_DECL) + if (VAR_P (dovar)) { if (integer_onep (step)) simple = 1; @@ -3283,7 +3637,15 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp); dovar_init e = {dovar, tmp}; inits.safe_push (e); + if (clauses->orderedc) + { + if (doacross_steps == NULL) + vec_safe_grow_cleared (doacross_steps, clauses->orderedc); + (*doacross_steps)[i] = step; + } } + if (orig_decls) + TREE_VEC_ELT (orig_decls, i) = dovar_decl; if (dovar_found == 2 && op == EXEC_OMP_SIMD @@ -3330,9 +3692,24 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar will have the value on entry of the last loop, rather than value after iterator increment. */ - tmp = gfc_evaluate_now (step, pblock); - tmp = fold_build2_loc (input_location, PLUS_EXPR, type, dovar, - tmp); + if (clauses->orderedc) + { + if (clauses->collapse <= 1 || i >= clauses->collapse) + tmp = count; + else + tmp = fold_build2_loc (input_location, PLUS_EXPR, + type, count, build_one_cst (type)); + tmp = fold_build2_loc (input_location, MULT_EXPR, type, + tmp, step); + tmp = fold_build2_loc (input_location, PLUS_EXPR, type, + from, tmp); + } + else + { + tmp = gfc_evaluate_now (step, pblock); + tmp = fold_build2_loc (input_location, PLUS_EXPR, type, + dovar, tmp); + } tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, dovar, tmp); for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) @@ -3426,6 +3803,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break; case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break; case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break; + case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break; case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break; default: gcc_unreachable (); } @@ -3436,8 +3814,13 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, OMP_FOR_INIT (stmt) = init; OMP_FOR_COND (stmt) = cond; OMP_FOR_INCR (stmt) = incr; + if (orig_decls) + OMP_FOR_ORIG_DECLS (stmt) = orig_decls; gfc_add_expr_to_block (&block, stmt); + vec_free (doacross_steps); + doacross_steps = saved_doacross_steps; + return gfc_finish_block (&block); } @@ -3539,8 +3922,11 @@ gfc_trans_omp_master (gfc_code *code) static tree gfc_trans_omp_ordered (gfc_code *code) { + tree omp_clauses = gfc_trans_omp_clauses (NULL, code->ext.omp_clauses, + code->loc); return build2_loc (input_location, OMP_ORDERED, void_type_node, - gfc_trans_code (code->block->next), NULL_TREE); + code->block ? gfc_trans_code (code->block->next) + : NULL_TREE, omp_clauses); } static tree @@ -3552,7 +3938,9 @@ gfc_trans_omp_parallel (gfc_code *code) gfc_start_block (&block); omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, code->loc); + pushlevel (); stmt = gfc_trans_omp_code (code->block->next, true); + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, omp_clauses); gfc_add_expr_to_block (&block, stmt); @@ -3567,6 +3955,7 @@ enum GFC_OMP_SPLIT_DISTRIBUTE, GFC_OMP_SPLIT_TEAMS, GFC_OMP_SPLIT_TARGET, + GFC_OMP_SPLIT_TASKLOOP, GFC_OMP_SPLIT_NUM }; @@ -3577,7 +3966,8 @@ enum GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL), GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE), GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS), - GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET) + GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET), + GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP) }; static void @@ -3628,6 +4018,23 @@ gfc_split_omp_clauses (gfc_code *code, case EXEC_OMP_TARGET: innermost = GFC_OMP_SPLIT_TARGET; break; + case EXEC_OMP_TARGET_PARALLEL: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL; + innermost = GFC_OMP_SPLIT_PARALLEL; + break; + case EXEC_OMP_TARGET_PARALLEL_DO: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO + | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TARGET_SIMD: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_TARGET_TEAMS: mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS; innermost = GFC_OMP_SPLIT_TEAMS; @@ -3652,6 +4059,13 @@ gfc_split_omp_clauses (gfc_code *code, | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_TASKLOOP: + innermost = GFC_OMP_SPLIT_TASKLOOP; + break; + case EXEC_OMP_TASKLOOP_SIMD: + mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_TEAMS: innermost = GFC_OMP_SPLIT_TEAMS; break; @@ -3688,8 +4102,17 @@ gfc_split_omp_clauses (gfc_code *code, /* First the clauses that are unique to some constructs. */ clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP] = code->ext.omp_clauses->lists[OMP_LIST_MAP]; + clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR] + = 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].defaultmap + = code->ext.omp_clauses->defaultmap; + clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET] + = code->ext.omp_clauses->if_exprs[OMP_IF_TARGET]; + /* And this is copied to all. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr + = code->ext.omp_clauses->if_expr; } if (mask & GFC_OMP_MASK_TEAMS) { @@ -3698,7 +4121,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->num_teams; clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = code->ext.omp_clauses->thread_limit; - /* Shared and default clauses are allowed on parallel and teams. */ + /* Shared and default clauses are allowed on parallel, teams + and taskloop. */ clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED] = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing @@ -3724,19 +4148,34 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->num_threads; clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind = code->ext.omp_clauses->proc_bind; - /* Shared and default clauses are allowed on parallel and teams. */ + /* Shared and default clauses are allowed on parallel, teams + and taskloop. */ clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED] = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing = code->ext.omp_clauses->default_sharing; + clausesa[GFC_OMP_SPLIT_PARALLEL].if_exprs[OMP_IF_PARALLEL] + = code->ext.omp_clauses->if_exprs[OMP_IF_PARALLEL]; + /* And this is copied to all. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr + = code->ext.omp_clauses->if_expr; } if (mask & GFC_OMP_MASK_DO) { /* First the clauses that are unique to some constructs. */ clausesa[GFC_OMP_SPLIT_DO].ordered = code->ext.omp_clauses->ordered; + clausesa[GFC_OMP_SPLIT_DO].orderedc + = code->ext.omp_clauses->orderedc; clausesa[GFC_OMP_SPLIT_DO].sched_kind = code->ext.omp_clauses->sched_kind; + if (innermost == GFC_OMP_SPLIT_SIMD) + clausesa[GFC_OMP_SPLIT_DO].sched_simd + = code->ext.omp_clauses->sched_simd; + clausesa[GFC_OMP_SPLIT_DO].sched_monotonic + = code->ext.omp_clauses->sched_monotonic; + clausesa[GFC_OMP_SPLIT_DO].sched_nonmonotonic + = code->ext.omp_clauses->sched_nonmonotonic; clausesa[GFC_OMP_SPLIT_DO].chunk_size = code->ext.omp_clauses->chunk_size; clausesa[GFC_OMP_SPLIT_DO].nowait @@ -3749,25 +4188,60 @@ gfc_split_omp_clauses (gfc_code *code, { clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr = code->ext.omp_clauses->safelen_expr; - clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LINEAR] - = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; + clausesa[GFC_OMP_SPLIT_SIMD].simdlen_expr + = code->ext.omp_clauses->simdlen_expr; clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED] = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED]; /* Duplicate collapse. */ clausesa[GFC_OMP_SPLIT_SIMD].collapse = code->ext.omp_clauses->collapse; } - /* Private clause is supported on all constructs but target, + if (mask & GFC_OMP_MASK_TASKLOOP) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].nogroup + = code->ext.omp_clauses->nogroup; + clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize + = code->ext.omp_clauses->grainsize; + clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks + = code->ext.omp_clauses->num_tasks; + clausesa[GFC_OMP_SPLIT_TASKLOOP].priority + = code->ext.omp_clauses->priority; + clausesa[GFC_OMP_SPLIT_TASKLOOP].final_expr + = code->ext.omp_clauses->final_expr; + clausesa[GFC_OMP_SPLIT_TASKLOOP].untied + = code->ext.omp_clauses->untied; + clausesa[GFC_OMP_SPLIT_TASKLOOP].mergeable + = code->ext.omp_clauses->mergeable; + clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP] + = code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP]; + /* And this is copied to all. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr + = code->ext.omp_clauses->if_expr; + /* Shared and default clauses are allowed on parallel, teams + and taskloop. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_SHARED] + = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; + clausesa[GFC_OMP_SPLIT_TASKLOOP].default_sharing + = code->ext.omp_clauses->default_sharing; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].collapse + = code->ext.omp_clauses->collapse; + } + /* Private clause is supported on all constructs, it is enough to put it on the innermost one. For - !$ omp do put it on parallel though, + !$ omp parallel do put it on parallel though, as that's what we did for OpenMP 3.1. */ clausesa[innermost == GFC_OMP_SPLIT_DO ? (int) GFC_OMP_SPLIT_PARALLEL : innermost].lists[OMP_LIST_PRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE]; /* Firstprivate clause is supported on all constructs but - target and simd. Put it on the outermost of those and - duplicate on parallel. */ + simd. Put it on the outermost of those and duplicate + on parallel and teams. */ + if (mask & GFC_OMP_MASK_TARGET) + clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; if (mask & GFC_OMP_MASK_TEAMS) clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; @@ -3780,9 +4254,12 @@ gfc_split_omp_clauses (gfc_code *code, else if (mask & GFC_OMP_MASK_DO) clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; - /* Lastprivate is allowed on do and simd. In - parallel do{, simd} we actually want to put it on + /* Lastprivate is allowed on distribute, do and simd. + In parallel do{, simd} we actually want to put it on parallel rather than do. */ + if (mask & GFC_OMP_MASK_DISTRIBUTE) + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; if (mask & GFC_OMP_MASK_PARALLEL) clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; @@ -3807,13 +4284,10 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_SIMD) clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_REDUCTION] = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; - /* FIXME: This is currently being discussed. */ - if (mask & GFC_OMP_MASK_PARALLEL) - clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr - = code->ext.omp_clauses->if_expr; - else - clausesa[GFC_OMP_SPLIT_TARGET].if_expr - = code->ext.omp_clauses->if_expr; + /* Linear clause is supported on do and simd, + put it on the innermost one. */ + clausesa[innermost].lists[OMP_LIST_LINEAR] + = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; } if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) @@ -3997,10 +4471,7 @@ gfc_trans_omp_parallel_workshare (gfc_code *code) code->loc); pushlevel (); stmt = gfc_trans_omp_workshare (code, &workshare_clauses); - if (TREE_CODE (stmt) != BIND_EXPR) - stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); - else - poplevel (0, 0); + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, omp_clauses); OMP_PARALLEL_COMBINED (stmt) = 1; @@ -4060,7 +4531,9 @@ gfc_trans_omp_task (gfc_code *code) gfc_start_block (&block); omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, code->loc); + pushlevel (); stmt = gfc_trans_omp_code (code->block->next, true); + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); stmt = build2_loc (input_location, OMP_TASK, void_type_node, stmt, omp_clauses); gfc_add_expr_to_block (&block, stmt); @@ -4157,11 +4630,12 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa) } static tree -gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa) +gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa, + tree omp_clauses) { stmtblock_t block; gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; - tree stmt, omp_clauses = NULL_TREE; + tree stmt; bool combined = true; gfc_start_block (&block); @@ -4172,8 +4646,9 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa) } if (flag_openmp) omp_clauses - = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TEAMS], - code->loc); + = chainon (omp_clauses, + gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TEAMS], + code->loc)); switch (code->op) { case EXEC_OMP_TARGET_TEAMS: @@ -4191,10 +4666,13 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa) stmt = gfc_trans_omp_distribute (code, clausesa); break; } - stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt, - omp_clauses); - if (combined) - OMP_TEAMS_COMBINED (stmt) = 1; + if (flag_openmp) + { + stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt, + omp_clauses); + if (combined) + OMP_TEAMS_COMBINED (stmt) = 1; + } gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); } @@ -4212,20 +4690,128 @@ gfc_trans_omp_target (gfc_code *code) omp_clauses = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET], code->loc); - if (code->op == EXEC_OMP_TARGET) - stmt = gfc_trans_omp_code (code->block->next, true); - else + switch (code->op) { + case EXEC_OMP_TARGET: pushlevel (); - stmt = gfc_trans_omp_teams (code, clausesa); + stmt = gfc_trans_omp_code (code->block->next, true); + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + break; + case EXEC_OMP_TARGET_PARALLEL: + { + stmtblock_t iblock; + + gfc_start_block (&iblock); + tree inner_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + stmt = gfc_trans_omp_code (code->block->next, true); + stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, + inner_clauses); + gfc_add_expr_to_block (&iblock, stmt); + stmt = gfc_finish_block (&iblock); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + } + break; + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + stmt = gfc_trans_omp_parallel_do (code, &block, clausesa); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + case EXEC_OMP_TARGET_SIMD: + stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block, + &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + default: + if (flag_openmp + && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams + || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit)) + { + gfc_omp_clauses clausesb; + tree teams_clauses; + /* For combined !$omp target teams, the num_teams and + 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.thread_limit = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams = NULL; + clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = NULL; + teams_clauses + = gfc_trans_omp_clauses (&block, &clausesb, code->loc); + pushlevel (); + stmt = gfc_trans_omp_teams (code, clausesa, teams_clauses); + } + else + { + pushlevel (); + stmt = gfc_trans_omp_teams (code, clausesa, NULL_TREE); + } + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + } + if (flag_openmp) + { + stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt, + omp_clauses); + if (code->op != EXEC_OMP_TARGET) + OMP_TARGET_COMBINED (stmt) = 1; + } + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_taskloop (gfc_code *code) +{ + stmtblock_t block; + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + gfc_split_omp_clauses (code, clausesa); + if (flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TASKLOOP], + code->loc); + switch (code->op) + { + case EXEC_OMP_TASKLOOP: + /* This is handled in gfc_trans_omp_do. */ + gcc_unreachable (); + break; + case EXEC_OMP_TASKLOOP_SIMD: + stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block, + &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else poplevel (0, 0); + break; + default: + gcc_unreachable (); } if (flag_openmp) - stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt, - omp_clauses); + { + tree taskloop = make_node (OMP_TASKLOOP); + TREE_TYPE (taskloop) = void_type_node; + OMP_FOR_BODY (taskloop) = stmt; + OMP_FOR_CLAUSES (taskloop) = omp_clauses; + stmt = taskloop; + } gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); } @@ -4247,6 +4833,36 @@ gfc_trans_omp_target_data (gfc_code *code) } static tree +gfc_trans_omp_target_enter_data (gfc_code *code) +{ + stmtblock_t block; + tree stmt, omp_clauses; + + gfc_start_block (&block); + omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_target_exit_data (gfc_code *code) +{ + stmtblock_t block; + tree stmt, omp_clauses; + + gfc_start_block (&block); + omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_target_update (gfc_code *code) { stmtblock_t block; @@ -4490,6 +5106,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DO: case EXEC_OMP_SIMD: + case EXEC_OMP_TASKLOOP: return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses, NULL); case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: @@ -4519,6 +5136,10 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_SINGLE: return gfc_trans_omp_single (code, code->ext.omp_clauses); case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -4527,12 +5148,18 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_target (code); case EXEC_OMP_TARGET_DATA: return gfc_trans_omp_target_data (code); + case EXEC_OMP_TARGET_ENTER_DATA: + return gfc_trans_omp_target_enter_data (code); + case EXEC_OMP_TARGET_EXIT_DATA: + return gfc_trans_omp_target_exit_data (code); case EXEC_OMP_TARGET_UPDATE: return gfc_trans_omp_target_update (code); case EXEC_OMP_TASK: return gfc_trans_omp_task (code); case EXEC_OMP_TASKGROUP: return gfc_trans_omp_taskgroup (code); + case EXEC_OMP_TASKLOOP_SIMD: + return gfc_trans_omp_taskloop (code); case EXEC_OMP_TASKWAIT: return gfc_trans_omp_taskwait (); case EXEC_OMP_TASKYIELD: @@ -4542,7 +5169,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: - return gfc_trans_omp_teams (code, NULL); + return gfc_trans_omp_teams (code, NULL, NULL_TREE); case EXEC_OMP_WORKSHARE: return gfc_trans_omp_workshare (code, code->ext.omp_clauses); default: diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 727d72f609..98687c8063 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1,5 +1,5 @@ /* Statement translation -- generate GCC trees from gfc_code. - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -650,7 +650,7 @@ gfc_trans_stop (gfc_code *code, bool error_stop) : gfor_fndecl_error_stop_numeric) : (flag_coarray == GFC_FCOARRAY_LIB ? gfor_fndecl_caf_stop_numeric - : gfor_fndecl_stop_numeric_f08), 1, + : gfor_fndecl_stop_numeric), 1, fold_convert (gfc_int4_type_node, se.expr)); } else @@ -674,6 +674,24 @@ gfc_trans_stop (gfc_code *code, bool error_stop) return gfc_finish_block (&se.pre); } +/* Translate the FAIL IMAGE statement. */ + +tree +gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED) +{ + if (flag_coarray == GFC_FCOARRAY_LIB) + return build_call_expr_loc (input_location, + gfor_fndecl_caf_fail_image, 1, + build_int_cst (pchar_type_node, 0)); + else + { + const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4); + gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name); + tree tmp = gfc_get_symbol_decl (exsym); + return build_call_expr_loc (input_location, tmp, 1, integer_zero_node); + } +} + tree gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op) @@ -725,7 +743,8 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op) return NULL_TREE; } - gfc_get_caf_token_offset (&token, NULL, caf_decl, NULL_TREE, code->expr1); + gfc_get_caf_token_offset (&se, &token, NULL, caf_decl, NULL_TREE, + code->expr1); if (gfc_is_coindexed (code->expr1)) image_index = gfc_caf_get_image_index (&se.pre, code->expr1, caf_decl); @@ -921,7 +940,10 @@ gfc_trans_event_post_wait (gfc_code *code, gfc_exec_op op) return NULL_TREE; } - gfc_get_caf_token_offset (&token, NULL, caf_decl, NULL_TREE, code->expr1); + gfc_init_se (&argse, NULL); + gfc_get_caf_token_offset (&argse, &token, NULL, caf_decl, NULL_TREE, + code->expr1); + gfc_add_block_to_block (&se.pre, &argse.pre); if (gfc_is_coindexed (code->expr1)) image_index = gfc_caf_get_image_index (&se.pre, code->expr1, caf_decl); @@ -1808,11 +1830,11 @@ gfc_trans_block_construct (gfc_code* code) return gfc_finish_wrapped_block (&block); } +/* Translate the simple DO construct in a C-style manner. + This is where the loop variable has integer type and step +-1. + Following code will generate infinite loop in case where TO is INT_MAX + (for +1 step) or INT_MIN (for -1 step) -/* Translate the simple DO construct. This is where the loop variable has - integer type and step +-1. We can't use this in the general case - because integer overflow and floating point errors could give incorrect - results. We translate a do loop from: DO dovar = from, to, step @@ -1822,22 +1844,20 @@ gfc_trans_block_construct (gfc_code* code) to: [Evaluate loop bounds and step] - dovar = from; - if ((step > 0) ? (dovar <= to) : (dovar => to)) - { - for (;;) - { - body; - cycle_label: - cond = (dovar == to); - dovar += step; - if (cond) goto end_label; - } + dovar = from; + for (;;) + { + if (dovar > to) + goto end_label; + body; + cycle_label: + dovar += step; } - end_label: + end_label: - This helps the optimizers by avoiding the extra induction variable - used in the general case. */ + This helps the optimizers by avoiding the extra pre-header condition and + we save a register as we just compare the updated IV (not a value in + previous step). */ static tree gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, @@ -1851,14 +1871,14 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, tree cycle_label; tree exit_label; location_t loc; - type = TREE_TYPE (dovar); + bool is_step_positive = tree_int_cst_sgn (step) > 0; loc = code->ext.iterator->start->where.lb->location; /* Initialize the DO variable: dovar = from. */ gfc_add_modify_loc (loc, pblock, dovar, - fold_convert (TREE_TYPE(dovar), from)); + fold_convert (TREE_TYPE (dovar), from)); /* Save value for do-tinkering checking. */ if (gfc_option.rtcheck & GFC_RTCHECK_DO) @@ -1871,13 +1891,53 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, cycle_label = gfc_build_label_decl (NULL_TREE); exit_label = gfc_build_label_decl (NULL_TREE); - /* Put the labels where they can be found later. See gfc_trans_do(). */ + /* Put the labels where they can be found later. See gfc_trans_do(). */ code->cycle_label = cycle_label; code->exit_label = exit_label; /* Loop body. */ gfc_start_block (&body); + /* Exit the loop if there is an I/O result condition or error. */ + if (exit_cond) + { + tmp = build1_v (GOTO_EXPR, exit_label); + tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, + exit_cond, tmp, + build_empty_stmt (loc)); + gfc_add_expr_to_block (&body, tmp); + } + + /* Evaluate the loop condition. */ + if (is_step_positive) + cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, dovar, + fold_convert (type, to)); + else + cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, dovar, + fold_convert (type, to)); + + cond = gfc_evaluate_now_loc (loc, cond, &body); + + /* The loop exit. */ + tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label); + TREE_USED (exit_label) = 1; + tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, + cond, tmp, build_empty_stmt (loc)); + gfc_add_expr_to_block (&body, tmp); + + /* Check whether the induction variable is equal to INT_MAX + (respectively to INT_MIN). */ + if (gfc_option.rtcheck & GFC_RTCHECK_DO) + { + tree boundary = is_step_positive ? TYPE_MAX_VALUE (type) + : TYPE_MIN_VALUE (type); + + tmp = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, + dovar, boundary); + gfc_trans_runtime_check (true, false, tmp, &body, &code->loc, + "Loop iterates infinitely"); + } + /* Main loop body. */ tmp = gfc_trans_code_cond (code->block->next, exit_cond); gfc_add_expr_to_block (&body, tmp); @@ -1898,21 +1958,6 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, "Loop variable has been modified"); } - /* Exit the loop if there is an I/O result condition or error. */ - if (exit_cond) - { - tmp = build1_v (GOTO_EXPR, exit_label); - tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, - exit_cond, tmp, - build_empty_stmt (loc)); - gfc_add_expr_to_block (&body, tmp); - } - - /* Evaluate the loop condition. */ - cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, dovar, - to); - cond = gfc_evaluate_now_loc (loc, cond, &body); - /* Increment the loop variable. */ tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step); gfc_add_modify_loc (loc, &body, dovar, tmp); @@ -1920,26 +1965,10 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, if (gfc_option.rtcheck & GFC_RTCHECK_DO) gfc_add_modify_loc (loc, &body, saved_dovar, dovar); - /* The loop exit. */ - tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label); - TREE_USED (exit_label) = 1; - tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, - cond, tmp, build_empty_stmt (loc)); - gfc_add_expr_to_block (&body, tmp); - /* Finish the loop body. */ tmp = gfc_finish_block (&body); tmp = fold_build1_loc (loc, LOOP_EXPR, void_type_node, tmp); - /* Only execute the loop if the number of iterations is positive. */ - if (tree_int_cst_sgn (step) > 0) - cond = fold_build2_loc (loc, LE_EXPR, boolean_type_node, dovar, - to); - else - cond = fold_build2_loc (loc, GE_EXPR, boolean_type_node, dovar, - to); - tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, tmp, - build_empty_stmt (loc)); gfc_add_expr_to_block (pblock, tmp); /* Add the exit label. */ @@ -2042,8 +2071,8 @@ gfc_trans_do (gfc_code * code, tree exit_cond) if (TREE_CODE (type) == INTEGER_TYPE && (integer_onep (step) || tree_int_cst_equal (step, integer_minus_one_node))) - return gfc_trans_simple_do (code, &block, dovar, from, to, step, exit_cond); - + return gfc_trans_simple_do (code, &block, dovar, from, to, step, + exit_cond); if (TREE_CODE (type) == INTEGER_TYPE) utype = unsigned_type_for (type); @@ -2107,7 +2136,8 @@ gfc_trans_do (gfc_code * code, tree exit_cond) pos = build2 (COMPOUND_EXPR, void_type_node, fold_build2 (MODIFY_EXPR, void_type_node, countm1, tmp2), - build3_loc (loc, COND_EXPR, void_type_node, tmp, + build3_loc (loc, COND_EXPR, void_type_node, + gfc_unlikely (tmp, PRED_FORTRAN_LOOP_PREHEADER), build1_loc (loc, GOTO_EXPR, void_type_node, exit_label), NULL_TREE)); @@ -2121,7 +2151,8 @@ gfc_trans_do (gfc_code * code, tree exit_cond) neg = build2 (COMPOUND_EXPR, void_type_node, fold_build2 (MODIFY_EXPR, void_type_node, countm1, tmp2), - build3_loc (loc, COND_EXPR, void_type_node, tmp, + build3_loc (loc, COND_EXPR, void_type_node, + gfc_unlikely (tmp, PRED_FORTRAN_LOOP_PREHEADER), build1_loc (loc, GOTO_EXPR, void_type_node, exit_label), NULL_TREE)); @@ -2318,6 +2349,125 @@ gfc_trans_do_while (gfc_code * code) } +/* Deal with the particular case of SELECT_TYPE, where the vtable + addresses are used for the selection. Since these are not sorted, + the selection has to be made by a series of if statements. */ + +static tree +gfc_trans_select_type_cases (gfc_code * code) +{ + gfc_code *c; + gfc_case *cp; + tree tmp; + tree cond; + tree low; + tree high; + gfc_se se; + gfc_se cse; + stmtblock_t block; + stmtblock_t body; + bool def = false; + gfc_expr *e; + gfc_start_block (&block); + + /* Calculate the switch expression. */ + gfc_init_se (&se, NULL); + gfc_conv_expr_val (&se, code->expr1); + gfc_add_block_to_block (&block, &se.pre); + + /* Generate an expression for the selector hash value, for + use to resolve character cases. */ + e = gfc_copy_expr (code->expr1->value.function.actual->expr); + gfc_add_hash_component (e); + + TREE_USED (code->exit_label) = 0; + +repeat: + for (c = code->block; c; c = c->block) + { + cp = c->ext.block.case_list; + + /* Assume it's the default case. */ + low = NULL_TREE; + high = NULL_TREE; + tmp = NULL_TREE; + + /* Put the default case at the end. */ + if ((!def && !cp->low) || (def && cp->low)) + continue; + + if (cp->low && (cp->ts.type == BT_CLASS + || cp->ts.type == BT_DERIVED)) + { + gfc_init_se (&cse, NULL); + gfc_conv_expr_val (&cse, cp->low); + gfc_add_block_to_block (&block, &cse.pre); + low = cse.expr; + } + else if (cp->ts.type != BT_UNKNOWN) + { + gcc_assert (cp->high); + gfc_init_se (&cse, NULL); + gfc_conv_expr_val (&cse, cp->high); + gfc_add_block_to_block (&block, &cse.pre); + high = cse.expr; + } + + gfc_init_block (&body); + + /* Add the statements for this case. */ + tmp = gfc_trans_code (c->next); + gfc_add_expr_to_block (&body, tmp); + + /* Break to the end of the SELECT TYPE construct. The default + case just falls through. */ + if (!def) + { + TREE_USED (code->exit_label) = 1; + tmp = build1_v (GOTO_EXPR, code->exit_label); + gfc_add_expr_to_block (&body, tmp); + } + + tmp = gfc_finish_block (&body); + + if (low != NULL_TREE) + { + /* Compare vtable pointers. */ + cond = fold_build2_loc (input_location, EQ_EXPR, + TREE_TYPE (se.expr), se.expr, low); + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, + cond, tmp, + build_empty_stmt (input_location)); + } + else if (high != NULL_TREE) + { + /* Compare hash values for character cases. */ + gfc_init_se (&cse, NULL); + gfc_conv_expr_val (&cse, e); + gfc_add_block_to_block (&block, &cse.pre); + + cond = fold_build2_loc (input_location, EQ_EXPR, + TREE_TYPE (se.expr), high, cse.expr); + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, + cond, tmp, + build_empty_stmt (input_location)); + } + + gfc_add_expr_to_block (&block, tmp); + } + + if (!def) + { + def = true; + goto repeat; + } + + gfc_free_expr (e); + + return gfc_finish_block (&block); +} + + /* Translate the SELECT CASE construct for INTEGER case expressions, without killing all potential optimizations. The problem is that Fortran allows unbounded cases, but the back-end does not, so we @@ -2959,6 +3109,35 @@ gfc_trans_select (gfc_code * code) return gfc_finish_block (&block); } +tree +gfc_trans_select_type (gfc_code * code) +{ + stmtblock_t block; + tree body; + tree exit_label; + + gcc_assert (code && code->expr1); + gfc_init_block (&block); + + /* Build the exit label and hang it in. */ + exit_label = gfc_build_label_decl (NULL_TREE); + code->exit_label = exit_label; + + /* Empty SELECT constructs are legal. */ + if (code->block == NULL) + body = build_empty_stmt (input_location); + else + body = gfc_trans_select_type_cases (code); + + /* Build everything together. */ + gfc_add_expr_to_block (&block, body); + + if (TREE_USED (exit_label)) + gfc_add_expr_to_block (&block, build1_v (LABEL_EXPR, exit_label)); + + return gfc_finish_block (&block); +} + /* Traversal function to substitute a replacement symtree if the symbol in the expression is the same as that passed. f == 2 signals that @@ -3035,7 +3214,7 @@ forall_make_variable_temp (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) gfc_add_block_to_block (post, &tse.post); tse.expr = build_fold_indirect_ref_loc (input_location, tse.expr); - if (e->ts.type != BT_CHARACTER) + if (c->expr1->ref->u.ar.type != AR_SECTION) { /* Use the variable offset for the temporary. */ tmp = gfc_conv_array_offset (old_sym->backend_decl); @@ -3365,114 +3544,103 @@ gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock, static tree generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3, - tree count1, tree wheremask, bool invert) + tree count1, + gfc_ss *lss, gfc_ss *rss, + tree wheremask, bool invert) { - gfc_ss *lss; - gfc_se lse, rse; - stmtblock_t block, body; - gfc_loopinfo loop1; + stmtblock_t block, body1; + gfc_loopinfo loop; + gfc_se lse; + gfc_se rse; tree tmp; tree wheremaskexpr; - /* Walk the lhs. */ - lss = gfc_walk_expr (expr); + (void) rss; /* TODO: unused. */ - if (lss == gfc_ss_terminator) - { - gfc_start_block (&block); + gfc_start_block (&block); - gfc_init_se (&lse, NULL); + gfc_init_se (&rse, NULL); + gfc_init_se (&lse, NULL); - /* Translate the expression. */ + if (lss == gfc_ss_terminator) + { + gfc_init_block (&body1); gfc_conv_expr (&lse, expr); - - /* Form the expression for the temporary. */ - tmp = gfc_build_array_ref (tmp1, count1, NULL); - - /* Use the scalar assignment as is. */ - gfc_add_block_to_block (&block, &lse.pre); - gfc_add_modify (&block, lse.expr, tmp); - gfc_add_block_to_block (&block, &lse.post); - - /* Increment the count1. */ - tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (count1), - count1, gfc_index_one_node); - gfc_add_modify (&block, count1, tmp); - - tmp = gfc_finish_block (&block); + rse.expr = gfc_build_array_ref (tmp1, count1, NULL); } else { - gfc_start_block (&block); - - gfc_init_loopinfo (&loop1); - gfc_init_se (&rse, NULL); - gfc_init_se (&lse, NULL); + /* Initialize the loop. */ + gfc_init_loopinfo (&loop); - /* Associate the lss with the loop. */ - gfc_add_ss_to_loop (&loop1, lss); + /* We may need LSS to determine the shape of the expression. */ + gfc_add_ss_to_loop (&loop, lss); - /* Calculate the bounds of the scalarization. */ - gfc_conv_ss_startstride (&loop1); - /* Setup the scalarizing loops. */ - gfc_conv_loop_setup (&loop1, &expr->where); + gfc_conv_ss_startstride (&loop); + gfc_conv_loop_setup (&loop, &expr->where); gfc_mark_ss_chain_used (lss, 1); + /* Start the loop body. */ + gfc_start_scalarized_body (&loop, &body1); - /* Start the scalarized loop body. */ - gfc_start_scalarized_body (&loop1, &body); - - /* Setup the gfc_se structures. */ - gfc_copy_loopinfo_to_se (&lse, &loop1); + /* Translate the expression. */ + gfc_copy_loopinfo_to_se (&lse, &loop); lse.ss = lss; + gfc_conv_expr (&lse, expr); /* Form the expression of the temporary. */ - if (lss != gfc_ss_terminator) - rse.expr = gfc_build_array_ref (tmp1, count1, NULL); - /* Translate expr. */ - gfc_conv_expr (&lse, expr); + rse.expr = gfc_build_array_ref (tmp1, count1, NULL); + } - /* Use the scalar assignment. */ - rse.string_length = lse.string_length; - tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true, true); + /* Use the scalar assignment. */ + rse.string_length = lse.string_length; + tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, + expr->expr_type == EXPR_VARIABLE, false); - /* Form the mask expression according to the mask tree list. */ - if (wheremask) - { - wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL); - if (invert) - wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR, - TREE_TYPE (wheremaskexpr), - wheremaskexpr); - tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - wheremaskexpr, tmp, - build_empty_stmt (input_location)); - } + /* Form the mask expression according to the mask tree list. */ + if (wheremask) + { + wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL); + if (invert) + wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR, + TREE_TYPE (wheremaskexpr), + wheremaskexpr); + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, + wheremaskexpr, tmp, + build_empty_stmt (input_location)); + } - gfc_add_expr_to_block (&body, tmp); + gfc_add_expr_to_block (&body1, tmp); - /* Increment count1. */ - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - count1, gfc_index_one_node); - gfc_add_modify (&body, count1, tmp); + tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (count1), + count1, gfc_index_one_node); + gfc_add_modify (&body1, count1, tmp); + if (lss == gfc_ss_terminator) + gfc_add_block_to_block (&block, &body1); + else + { /* Increment count3. */ if (count3) { tmp = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, count3, - gfc_index_one_node); - gfc_add_modify (&body, count3, tmp); + gfc_array_index_type, + count3, gfc_index_one_node); + gfc_add_modify (&body1, count3, tmp); } /* Generate the copying loops. */ - gfc_trans_scalarizing_loops (&loop1, &body); - gfc_add_block_to_block (&block, &loop1.pre); - gfc_add_block_to_block (&block, &loop1.post); - gfc_cleanup_loop (&loop1); + gfc_trans_scalarizing_loops (&loop, &body1); - tmp = gfc_finish_block (&block); + gfc_add_block_to_block (&block, &loop.pre); + gfc_add_block_to_block (&block, &loop.post); + + gfc_cleanup_loop (&loop); + /* TODO: Reuse lss and rss when copying temp->lhs. Need to be careful + as tree nodes in SS may not be valid in different scope. */ } + + tmp = gfc_finish_block (&block); return tmp; } @@ -3828,26 +3996,39 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, /* Calculate the size of temporary needed in the assignment. Return loop, lss and rss which are used in function generate_loop_for_rhs_to_temp(). */ - gfc_init_block (&inner_size_body); - inner_size = compute_inner_temp_size (expr1, expr2, &inner_size_body, - &lss, &rss); - /* The type of LHS. Used in function allocate_temp_for_forall_nest */ - if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->length) + if (expr1->ts.type == BT_CHARACTER) { - if (!expr1->ts.u.cl->backend_decl) + type = NULL; + if (expr1->ref && expr1->ref->type == REF_SUBSTRING) { - gfc_se tse; - gfc_init_se (&tse, NULL); - gfc_conv_expr (&tse, expr1->ts.u.cl->length); - expr1->ts.u.cl->backend_decl = tse.expr; + gfc_se ssse; + gfc_init_se (&ssse, NULL); + gfc_conv_expr (&ssse, expr1); + type = gfc_get_character_type_len (gfc_default_character_kind, + ssse.string_length); + } + else + { + if (!expr1->ts.u.cl->backend_decl) + { + gfc_se tse; + gcc_assert (expr1->ts.u.cl->length); + gfc_init_se (&tse, NULL); + gfc_conv_expr (&tse, expr1->ts.u.cl->length); + expr1->ts.u.cl->backend_decl = tse.expr; + } + type = gfc_get_character_type_len (gfc_default_character_kind, + expr1->ts.u.cl->backend_decl); } - type = gfc_get_character_type_len (gfc_default_character_kind, - expr1->ts.u.cl->backend_decl); } else type = gfc_typenode_for_spec (&expr1->ts); + gfc_init_block (&inner_size_body); + inner_size = compute_inner_temp_size (expr1, expr2, &inner_size_body, + &lss, &rss); + /* Allocate temporary for nested forall construct according to the information in nested_forall_info and inner_size. */ tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type, inner_size, @@ -3869,8 +4050,14 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, if (wheremask) gfc_add_modify (block, count, gfc_index_zero_node); + /* TODO: Second call to compute_inner_temp_size to initialize lss and + rss; there must be a better way. */ + inner_size = compute_inner_temp_size (expr1, expr2, &inner_size_body, + &lss, &rss); + /* Generate codes to copy the temporary to lhs. */ tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, count, count1, + lss, rss, wheremask, invert); /* Generate body and loops according to the information in @@ -4327,8 +4514,8 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) /* Temporaries due to array assignment data dependencies introduce no end of problems. */ - if (need_temp) - gfc_trans_assign_need_temp (c->expr1, c->expr2, NULL, false, + if (need_temp || flag_test_forall_temp) + gfc_trans_assign_need_temp (c->expr1, c->expr2, NULL, false, nested_forall_info, &block); else { @@ -4356,7 +4543,12 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) /* Pointer assignment inside FORALL. */ case EXEC_POINTER_ASSIGN: need_temp = gfc_check_dependency (c->expr1, c->expr2, 0); - if (need_temp) + /* Avoid cases where a temporary would never be needed and where + the temp code is guaranteed to fail. */ + if (need_temp + || (flag_test_forall_temp + && c->expr2->expr_type != EXPR_CONSTANT + && c->expr2->expr_type != EXPR_NULL)) gfc_trans_pointer_assign_need_temp (c->expr1, c->expr2, nested_forall_info, &block); else @@ -4964,7 +5156,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert, if (nested_forall_info != NULL) { need_temp = gfc_check_dependency (expr1, expr2, 0); - if (need_temp && cnext->op != EXEC_ASSIGN_CALL) + if ((need_temp || flag_test_forall_temp) + && cnext->op != EXEC_ASSIGN_CALL) gfc_trans_assign_need_temp (expr1, expr2, cmask, invert, nested_forall_info, block); @@ -5289,13 +5482,41 @@ gfc_trans_exit (gfc_code * code) } +/* Get the initializer expression for the code and expr of an allocate. + When no initializer is needed return NULL. */ + +static gfc_expr * +allocate_get_initializer (gfc_code * code, gfc_expr * expr) +{ + if (!gfc_bt_struct (expr->ts.type) && expr->ts.type != BT_CLASS) + return NULL; + + /* An explicit type was given in allocate ( T:: object). */ + if (code->ext.alloc.ts.type == BT_DERIVED + && (code->ext.alloc.ts.u.derived->attr.alloc_comp + || gfc_has_default_initializer (code->ext.alloc.ts.u.derived))) + return gfc_default_initializer (&code->ext.alloc.ts); + + if (gfc_bt_struct (expr->ts.type) + && (expr->ts.u.derived->attr.alloc_comp + || gfc_has_default_initializer (expr->ts.u.derived))) + return gfc_default_initializer (&expr->ts); + + if (expr->ts.type == BT_CLASS + && (CLASS_DATA (expr)->ts.u.derived->attr.alloc_comp + || gfc_has_default_initializer (CLASS_DATA (expr)->ts.u.derived))) + return gfc_default_initializer (&CLASS_DATA (expr)->ts); + + return NULL; +} + /* Translate the ALLOCATE statement. */ tree gfc_trans_allocate (gfc_code * code) { gfc_alloc *al; - gfc_expr *expr, *e3rhs = NULL; + gfc_expr *expr, *e3rhs = NULL, *init_expr; gfc_se se, se_sz; tree tmp; tree parm; @@ -5317,8 +5538,10 @@ gfc_trans_allocate (gfc_code * code) stmtblock_t block; stmtblock_t post; tree nelems; - bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set; + bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray; + bool needs_caf_sync, caf_refs_comp; gfc_symtree *newsym = NULL; + symbol_attribute caf_attr; if (!code->ext.alloc.list) return NULL_TREE; @@ -5327,6 +5550,7 @@ gfc_trans_allocate (gfc_code * code) expr3 = expr3_vptr = expr3_len = expr3_esize = NULL_TREE; label_errmsg = label_finish = errmsg = errlen = NULL_TREE; e3_is = E3_UNSET; + is_coarray = needs_caf_sync = false; gfc_init_block (&block); gfc_init_block (&post); @@ -5367,7 +5591,9 @@ gfc_trans_allocate (gfc_code * code) if (code->expr3) { bool vtab_needed = false, temp_var_needed = false, - is_coarray = gfc_is_coarray (code->expr3); + temp_obj_created = false; + + is_coarray = gfc_is_coarray (code->expr3); /* Figure whether we need the vtab from expr3. */ for (al = code->ext.alloc.list; !vtab_needed && al != NULL; @@ -5426,7 +5652,10 @@ gfc_trans_allocate (gfc_code * code) if (code->expr3->rank != 0 && ((!attr.allocatable && !attr.pointer) || (code->expr3->expr_type == EXPR_FUNCTION - && code->expr3->ts.type != BT_CLASS))) + && (code->expr3->ts.type != BT_CLASS + || (code->expr3->value.function.isym + && code->expr3->value.function.isym + ->transformational))))) gfc_conv_expr_descriptor (&se, code->expr3); else gfc_conv_expr_reference (&se, code->expr3); @@ -5435,7 +5664,7 @@ gfc_trans_allocate (gfc_code * code) code->expr3->ts, false, true, false, false); - temp_var_needed = !VAR_P (se.expr); + temp_obj_created = temp_var_needed = !VAR_P (se.expr); } gfc_add_block_to_block (&block, &se.pre); gfc_add_block_to_block (&post, &se.post); @@ -5476,7 +5705,8 @@ gfc_trans_allocate (gfc_code * code) desc = tmp; tmp = gfc_class_data_get (tmp); } - e3_is = E3_DESC; + if (code->ext.alloc.arr_spec_from_expr3) + e3_is = E3_DESC; } else desc = !is_coarray ? se.expr @@ -5491,17 +5721,6 @@ gfc_trans_allocate (gfc_code * code) } gfc_add_modify_loc (input_location, &block, var, tmp); - /* Deallocate any allocatable components after all the allocations - and assignments of expr3 have been completed. */ - if (code->expr3->ts.type == BT_DERIVED - && code->expr3->rank == 0 - && code->expr3->ts.u.derived->attr.alloc_comp) - { - tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived, - var, 0); - gfc_add_expr_to_block (&post, tmp); - } - expr3 = var; if (se.string_length) /* Evaluate it assuming that it also is complicated like expr3. */ @@ -5512,6 +5731,21 @@ gfc_trans_allocate (gfc_code * code) expr3 = se.expr; expr3_len = se.string_length; } + + /* Deallocate any allocatable components in expressions that use a + temporary object, i.e. are not a simple alias of to an EXPR_VARIABLE. + E.g. temporaries of a function call need freeing of their components + here. */ + if ((code->expr3->ts.type == BT_DERIVED + || code->expr3->ts.type == BT_CLASS) + && (code->expr3->expr_type != EXPR_VARIABLE || temp_obj_created) + && code->expr3->ts.u.derived->attr.alloc_comp) + { + tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived, + expr3, code->expr3->rank); + gfc_prepend_expr_to_block (&post, tmp); + } + /* Store what the expr3 is to be used for. */ if (e3_is == E3_UNSET) e3_is = expr3 != NULL_TREE ? @@ -5609,73 +5843,6 @@ gfc_trans_allocate (gfc_code * code) else expr3_esize = TYPE_SIZE_UNIT ( gfc_typenode_for_spec (&code->expr3->ts)); - - /* The routine gfc_trans_assignment () already implements all - techniques needed. Unfortunately we may have a temporary - variable for the source= expression here. When that is the - case convert this variable into a temporary gfc_expr of type - EXPR_VARIABLE and used it as rhs for the assignment. The - advantage is, that we get scalarizer support for free, - don't have to take care about scalar to array treatment and - will benefit of every enhancements gfc_trans_assignment () - gets. - No need to check whether e3_is is E3_UNSET, because that is - done by expr3 != NULL_TREE. - Exclude variables since the following block does not handle - array sections. In any case, there is no harm in sending - variables to gfc_trans_assignment because there is no - evaluation of variables. */ - if (code->expr3->expr_type != EXPR_VARIABLE - && e3_is != E3_MOLD && expr3 != NULL_TREE - && DECL_P (expr3) && DECL_ARTIFICIAL (expr3)) - { - /* Build a temporary symtree and symbol. Do not add it to - the current namespace to prevent accidently modifying - a colliding symbol's as. */ - newsym = XCNEW (gfc_symtree); - /* The name of the symtree should be unique, because - gfc_create_var () took care about generating the - identifier. */ - newsym->name = gfc_get_string (IDENTIFIER_POINTER ( - DECL_NAME (expr3))); - newsym->n.sym = gfc_new_symbol (newsym->name, NULL); - /* The backend_decl is known. It is expr3, which is inserted - here. */ - newsym->n.sym->backend_decl = expr3; - e3rhs = gfc_get_expr (); - e3rhs->ts = code->expr3->ts; - e3rhs->rank = code->expr3->rank; - e3rhs->symtree = newsym; - /* Mark the symbol referenced or gfc_trans_assignment will - bug. */ - newsym->n.sym->attr.referenced = 1; - e3rhs->expr_type = EXPR_VARIABLE; - e3rhs->where = code->expr3->where; - /* Set the symbols type, upto it was BT_UNKNOWN. */ - newsym->n.sym->ts = e3rhs->ts; - /* Check whether the expr3 is array valued. */ - if (e3rhs->rank) - { - gfc_array_spec *arr; - arr = gfc_get_array_spec (); - arr->rank = e3rhs->rank; - arr->type = AS_DEFERRED; - /* Set the dimension and pointer attribute for arrays - to be on the safe side. */ - newsym->n.sym->attr.dimension = 1; - newsym->n.sym->attr.pointer = 1; - newsym->n.sym->as = arr; - gfc_add_full_array_ref (e3rhs, arr); - } - else if (POINTER_TYPE_P (TREE_TYPE (expr3))) - newsym->n.sym->attr.pointer = 1; - /* The string length is known to. Set it for char arrays. */ - if (e3rhs->ts.type == BT_CHARACTER) - newsym->n.sym->ts.u.cl->backend_decl = expr3_len; - gfc_commit_symbol (newsym->n.sym); - } - else - e3rhs = gfc_copy_expr (code->expr3); } gcc_assert (expr3_esize); expr3_esize = fold_convert (sizetype, expr3_esize); @@ -5709,6 +5876,95 @@ gfc_trans_allocate (gfc_code * code) } } + /* The routine gfc_trans_assignment () already implements all + techniques needed. Unfortunately we may have a temporary + variable for the source= expression here. When that is the + case convert this variable into a temporary gfc_expr of type + EXPR_VARIABLE and used it as rhs for the assignment. The + advantage is, that we get scalarizer support for free, + don't have to take care about scalar to array treatment and + will benefit of every enhancements gfc_trans_assignment () + gets. + No need to check whether e3_is is E3_UNSET, because that is + done by expr3 != NULL_TREE. + Exclude variables since the following block does not handle + array sections. In any case, there is no harm in sending + variables to gfc_trans_assignment because there is no + evaluation of variables. */ + if (code->expr3) + { + if (code->expr3->expr_type != EXPR_VARIABLE + && e3_is != E3_MOLD && expr3 != NULL_TREE + && DECL_P (expr3) && DECL_ARTIFICIAL (expr3)) + { + /* Build a temporary symtree and symbol. Do not add it to the current + namespace to prevent accidently modifying a colliding + symbol's as. */ + newsym = XCNEW (gfc_symtree); + /* The name of the symtree should be unique, because gfc_create_var () + took care about generating the identifier. */ + newsym->name + = gfc_get_string ("%s", IDENTIFIER_POINTER (DECL_NAME (expr3))); + newsym->n.sym = gfc_new_symbol (newsym->name, NULL); + /* The backend_decl is known. It is expr3, which is inserted + here. */ + newsym->n.sym->backend_decl = expr3; + e3rhs = gfc_get_expr (); + e3rhs->rank = code->expr3->rank; + e3rhs->symtree = newsym; + /* Mark the symbol referenced or gfc_trans_assignment will bug. */ + newsym->n.sym->attr.referenced = 1; + e3rhs->expr_type = EXPR_VARIABLE; + e3rhs->where = code->expr3->where; + /* Set the symbols type, upto it was BT_UNKNOWN. */ + if (IS_CLASS_ARRAY (code->expr3) + && code->expr3->expr_type == EXPR_FUNCTION + && code->expr3->value.function.isym + && code->expr3->value.function.isym->transformational) + { + e3rhs->ts = CLASS_DATA (code->expr3)->ts; + } + else if (code->expr3->ts.type == BT_CLASS + && !GFC_CLASS_TYPE_P (TREE_TYPE (expr3))) + e3rhs->ts = CLASS_DATA (code->expr3)->ts; + else + e3rhs->ts = code->expr3->ts; + newsym->n.sym->ts = e3rhs->ts; + /* Check whether the expr3 is array valued. */ + if (e3rhs->rank) + { + gfc_array_spec *arr; + arr = gfc_get_array_spec (); + arr->rank = e3rhs->rank; + arr->type = AS_DEFERRED; + /* Set the dimension and pointer attribute for arrays + to be on the safe side. */ + newsym->n.sym->attr.dimension = 1; + newsym->n.sym->attr.pointer = 1; + newsym->n.sym->as = arr; + if (IS_CLASS_ARRAY (code->expr3) + && code->expr3->expr_type == EXPR_FUNCTION + && code->expr3->value.function.isym + && code->expr3->value.function.isym->transformational) + { + gfc_array_spec *tarr; + tarr = gfc_get_array_spec (); + *tarr = *arr; + e3rhs->ts.u.derived->as = tarr; + } + gfc_add_full_array_ref (e3rhs, arr); + } + else if (POINTER_TYPE_P (TREE_TYPE (expr3))) + newsym->n.sym->attr.pointer = 1; + /* The string length is known, too. Set it for char arrays. */ + if (e3rhs->ts.type == BT_CHARACTER) + newsym->n.sym->ts.u.cl->backend_decl = expr3_len; + gfc_commit_symbol (newsym->n.sym); + } + else + e3rhs = gfc_copy_expr (code->expr3); + } + /* Loop over all objects to allocate. */ for (al = code->ext.alloc.list; al != NULL; al = al->next) { @@ -5773,14 +6029,21 @@ gfc_trans_allocate (gfc_code * code) needs to be provided, which is done most of the time by the pre-evaluation step. */ nelems = NULL_TREE; - if (expr3_len && code->expr3->ts.type == BT_CHARACTER) - /* When al is an array, then the element size for each element - in the array is needed, which is the product of the len and - esize for char arrays. */ - tmp = fold_build2_loc (input_location, MULT_EXPR, - TREE_TYPE (expr3_esize), expr3_esize, - fold_convert (TREE_TYPE (expr3_esize), - expr3_len)); + if (expr3_len && (code->expr3->ts.type == BT_CHARACTER + || code->expr3->ts.type == BT_CLASS)) + { + /* When al is an array, then the element size for each element + in the array is needed, which is the product of the len and + esize for char arrays. For unlimited polymorphics len can be + zero, therefore take the maximum of len and one. */ + tmp = fold_build2_loc (input_location, MAX_EXPR, + TREE_TYPE (expr3_len), + expr3_len, fold_convert (TREE_TYPE (expr3_len), + integer_one_node)); + tmp = fold_build2_loc (input_location, MULT_EXPR, + TREE_TYPE (expr3_esize), expr3_esize, + fold_convert (TREE_TYPE (expr3_esize), tmp)); + } else tmp = expr3_esize; if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen, @@ -5867,24 +6130,53 @@ gfc_trans_allocate (gfc_code * code) /* Handle size computation of the type declared to alloc. */ memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr))); + /* Store the caf-attributes for latter use. */ + if (flag_coarray == GFC_FCOARRAY_LIB + && (caf_attr = gfc_caf_attr (expr, true, &caf_refs_comp)) + .codimension) + { + /* Scalar allocatable components in coarray'ed derived types make + it here and are treated now. */ + tree caf_decl, token; + gfc_se caf_se; + + is_coarray = true; + /* Set flag, to add synchronize after the allocate. */ + needs_caf_sync = needs_caf_sync + || caf_attr.coarray_comp || !caf_refs_comp; + + gfc_init_se (&caf_se, NULL); + + caf_decl = gfc_get_tree_for_caf_expr (expr); + gfc_get_caf_token_offset (&caf_se, &token, NULL, caf_decl, + NULL_TREE, NULL); + gfc_add_block_to_block (&se.pre, &caf_se.pre); + gfc_allocate_allocatable (&se.pre, se.expr, memsz, + gfc_build_addr_expr (NULL_TREE, token), + NULL_TREE, NULL_TREE, NULL_TREE, + label_finish, expr, 1); + } /* Allocate - for non-pointers with re-alloc checking. */ - if (gfc_expr_attr (expr).allocatable) - gfc_allocate_allocatable (&se.pre, se.expr, memsz, NULL_TREE, - stat, errmsg, errlen, label_finish, - expr); + else if (gfc_expr_attr (expr).allocatable) + gfc_allocate_allocatable (&se.pre, se.expr, memsz, + NULL_TREE, stat, errmsg, errlen, + label_finish, expr, 0); else gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat); - - if (al->expr->ts.type == BT_DERIVED - && expr->ts.u.derived->attr.alloc_comp) - { - tmp = build_fold_indirect_ref_loc (input_location, se.expr); - tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0); - gfc_add_expr_to_block (&se.pre, tmp); - } } else { + /* Allocating coarrays needs a sync after the allocate executed. + Set the flag to add the sync after all objects are allocated. */ + if (flag_coarray == GFC_FCOARRAY_LIB + && (caf_attr = gfc_caf_attr (expr, true, &caf_refs_comp)) + .codimension) + { + is_coarray = true; + needs_caf_sync = needs_caf_sync + || caf_attr.coarray_comp || !caf_refs_comp; + } + if (expr->ts.type == BT_CHARACTER && al_len != NULL_TREE && expr3_len != NULL_TREE) { @@ -5896,7 +6188,7 @@ gfc_trans_allocate (gfc_code * code) al_len_needs_set = false; } else if (expr->ts.type == BT_CHARACTER && al_len != NULL_TREE - && code->ext.alloc.ts.u.cl->length) + && code->ext.alloc.ts.u.cl->length) { /* Cover the cases where a string length is explicitly specified by a type spec for deferred length character @@ -5927,8 +6219,9 @@ gfc_trans_allocate (gfc_code * code) gfc_add_expr_to_block (&block, tmp); } - /* Set the vptr. */ - if (al_vptr != NULL_TREE) + /* Set the vptr only when no source= is set. When source= is set, then + the trans_assignment below will set the vptr. */ + if (al_vptr != NULL_TREE && (!code->expr3 || code->expr3->mold)) { if (expr3_vptr != NULL_TREE) /* The vtab is already known, so just assign it. */ @@ -5983,7 +6276,7 @@ gfc_trans_allocate (gfc_code * code) expr3_len = NULL_TREE; } else if (code->ext.alloc.ts.type == BT_CHARACTER - && code->ext.alloc.ts.u.cl->length) + && code->ext.alloc.ts.u.cl->length) { /* Cover the cases where a string length is explicitly specified by a type spec for deferred length character @@ -6010,154 +6303,90 @@ gfc_trans_allocate (gfc_code * code) fold_convert (TREE_TYPE (al_len), integer_zero_node)); } + + init_expr = NULL; if (code->expr3 && !code->expr3->mold && e3_is != E3_MOLD) { /* Initialization via SOURCE block (or static default initializer). - Classes need some special handling, so catch them first. */ - if (expr3 != NULL_TREE - && TREE_CODE (expr3) != POINTER_PLUS_EXPR - && code->expr3->ts.type == BT_CLASS - && (expr->ts.type == BT_CLASS - || expr->ts.type == BT_DERIVED)) + Switch off automatic reallocation since we have just done the + ALLOCATE. */ + int realloc_lhs = flag_realloc_lhs; + gfc_expr *init_expr = gfc_expr_to_initialize (expr); + gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3); + flag_realloc_lhs = 0; + tmp = gfc_trans_assignment (init_expr, rhs, false, false, true, + false); + flag_realloc_lhs = realloc_lhs; + /* Free the expression allocated for init_expr. */ + gfc_free_expr (init_expr); + if (rhs != e3rhs) + gfc_free_expr (rhs); + gfc_add_expr_to_block (&block, tmp); + } + else if (code->expr3 && code->expr3->mold + && code->expr3->ts.type == BT_CLASS) + { + /* Use class_init_assign to initialize expr. */ + gfc_code *ini; + ini = gfc_get_code (EXEC_INIT_ASSIGN); + ini->expr1 = gfc_find_and_cut_at_last_class_ref (expr); + tmp = gfc_trans_class_init_assign (ini); + gfc_free_statements (ini); + gfc_add_expr_to_block (&block, tmp); + } + else if ((init_expr = allocate_get_initializer (code, expr))) + { + /* Use class_init_assign to initialize expr. */ + gfc_code *ini; + int realloc_lhs = flag_realloc_lhs; + ini = gfc_get_code (EXEC_INIT_ASSIGN); + ini->expr1 = gfc_expr_to_initialize (expr); + ini->expr2 = init_expr; + flag_realloc_lhs = 0; + tmp= gfc_trans_init_assign (ini); + flag_realloc_lhs = realloc_lhs; + gfc_free_statements (ini); + /* Init_expr is freeed by above free_statements, just need to null + it here. */ + init_expr = NULL; + gfc_add_expr_to_block (&block, tmp); + } + + /* Nullify all pointers in derived type coarrays. This registers a + token for them which allows their allocation. */ + if (is_coarray) + { + gfc_symbol *type = NULL; + symbol_attribute caf_attr; + int rank = 0; + if (code->ext.alloc.ts.type == BT_DERIVED + && code->ext.alloc.ts.u.derived->attr.pointer_comp) { - /* copy_class_to_class can be used for class arrays, too. - It just needs to be ensured, that the decl_saved_descriptor - has a way to get to the vptr. */ - tree to; - to = VAR_P (se.expr) ? se.expr : TREE_OPERAND (se.expr, 0); - tmp = gfc_copy_class_to_class (expr3, to, - nelems, upoly_expr); + type = code->ext.alloc.ts.u.derived; + rank = type->attr.dimension ? type->as->rank : 0; + gfc_clear_attr (&caf_attr); } - else if (al->expr->ts.type == BT_CLASS) + else if (expr->ts.type == BT_DERIVED + && expr->ts.u.derived->attr.pointer_comp) { - gfc_actual_arglist *actual, *last_arg; - gfc_expr *ppc; - gfc_code *ppc_code; - gfc_ref *ref, *dataref; - gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3); - - /* Do a polymorphic deep copy. */ - actual = gfc_get_actual_arglist (); - actual->expr = gfc_copy_expr (rhs); - if (rhs->ts.type == BT_CLASS) - gfc_add_data_component (actual->expr); - last_arg = actual->next = gfc_get_actual_arglist (); - last_arg->expr = gfc_copy_expr (al->expr); - last_arg->expr->ts.type = BT_CLASS; - gfc_add_data_component (last_arg->expr); - - dataref = NULL; - /* Make sure we go up through the reference chain to - the _data reference, where the arrayspec is found. */ - for (ref = last_arg->expr->ref; ref; ref = ref->next) - if (ref->type == REF_COMPONENT - && strcmp (ref->u.c.component->name, "_data") == 0) - dataref = ref; - - if (dataref && dataref->u.c.component->as) - { - gfc_array_spec *as = dataref->u.c.component->as; - gfc_free_ref_list (dataref->next); - dataref->next = NULL; - gfc_add_full_array_ref (last_arg->expr, as); - gfc_resolve_expr (last_arg->expr); - gcc_assert (last_arg->expr->ts.type == BT_CLASS - || last_arg->expr->ts.type == BT_DERIVED); - last_arg->expr->ts.type = BT_CLASS; - } - if (rhs->ts.type == BT_CLASS) - { - if (rhs->ref) - ppc = gfc_find_and_cut_at_last_class_ref (rhs); - else - ppc = gfc_copy_expr (rhs); - gfc_add_vptr_component (ppc); - } - else - ppc = gfc_lval_expr_from_sym (gfc_find_vtab (&rhs->ts)); - gfc_add_component_ref (ppc, "_copy"); - - ppc_code = gfc_get_code (EXEC_CALL); - ppc_code->resolved_sym = ppc->symtree->n.sym; - ppc_code->loc = al->expr->where; - /* Although '_copy' is set to be elemental in class.c, it is - not staying that way. Find out why, sometime.... */ - ppc_code->resolved_sym->attr.elemental = 1; - ppc_code->ext.actual = actual; - ppc_code->expr1 = ppc; - /* Since '_copy' is elemental, the scalarizer will take care - of arrays in gfc_trans_call. */ - tmp = gfc_trans_call (ppc_code, true, NULL, NULL, false); - /* We need to add the - if (al_len > 0) - al_vptr->copy (expr3_data, al_data, expr3_len, al_len); - else - al_vptr->copy (expr3_data, al_data); - block, because al is unlimited polymorphic or a deferred - length char array, whose copy routine needs the array lengths - as third and fourth arguments. */ - if (al_len && UNLIMITED_POLY (code->expr3)) - { - tree stdcopy, extcopy; - /* Add al%_len. */ - last_arg->next = gfc_get_actual_arglist (); - last_arg = last_arg->next; - last_arg->expr = gfc_find_and_cut_at_last_class_ref ( - al->expr); - gfc_add_len_component (last_arg->expr); - /* Add expr3's length. */ - last_arg->next = gfc_get_actual_arglist (); - last_arg = last_arg->next; - if (code->expr3->ts.type == BT_CLASS) - { - last_arg->expr = - gfc_find_and_cut_at_last_class_ref (code->expr3); - gfc_add_len_component (last_arg->expr); - } - else if (code->expr3->ts.type == BT_CHARACTER) - last_arg->expr = - gfc_copy_expr (code->expr3->ts.u.cl->length); - else - gcc_unreachable (); - - stdcopy = tmp; - extcopy = gfc_trans_call (ppc_code, true, NULL, NULL, false); - - tmp = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, expr3_len, - integer_zero_node); - tmp = fold_build3_loc (input_location, COND_EXPR, - void_type_node, tmp, extcopy, stdcopy); - } - gfc_free_statements (ppc_code); - if (rhs != e3rhs) - gfc_free_expr (rhs); + type = expr->ts.u.derived; + rank = expr->rank; + caf_attr = gfc_caf_attr (expr, true); } - else + + /* Initialize the tokens of pointer components in derived type + coarrays. */ + if (type) { - /* Switch off automatic reallocation since we have just - done the ALLOCATE. */ - int realloc_lhs = flag_realloc_lhs; - flag_realloc_lhs = 0; - tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr), - e3rhs, false, false); - flag_realloc_lhs = realloc_lhs; + tmp = (caf_attr.codimension && !caf_attr.dimension) + ? gfc_conv_descriptor_data_get (se.expr) : se.expr; + tmp = gfc_nullify_alloc_comp (type, tmp, rank, + GFC_STRUCTURE_CAF_MODE_IN_COARRAY); + gfc_add_expr_to_block (&block, tmp); } - gfc_add_expr_to_block (&block, tmp); - } - else if (code->expr3 && code->expr3->mold - && code->expr3->ts.type == BT_CLASS) - { - /* Since the _vptr has already been assigned to the allocate - object, we can use gfc_copy_class_to_class in its - initialization mode. */ - tmp = TREE_OPERAND (se.expr, 0); - tmp = gfc_copy_class_to_class (NULL_TREE, tmp, nelems, - upoly_expr); - gfc_add_expr_to_block (&block, tmp); } - gfc_free_expr (expr); + gfc_free_expr (expr); } // for-loop if (e3rhs) @@ -6225,6 +6454,15 @@ gfc_trans_allocate (gfc_code * code) gfc_add_modify (&block, se.expr, tmp); } + if (needs_caf_sync) + { + /* Add a sync all after the allocation has been executed. */ + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, + 3, null_pointer_node, null_pointer_node, + integer_zero_node); + gfc_add_expr_to_block (&post, tmp); + } + gfc_add_block_to_block (&block, &se.post); gfc_add_block_to_block (&block, &post); @@ -6277,6 +6515,9 @@ gfc_trans_deallocate (gfc_code *code) for (al = code->ext.alloc.list; al != NULL; al = al->next) { gfc_expr *expr = gfc_copy_expr (al->expr); + bool is_coarray = false, is_coarray_array = false; + int caf_mode = 0; + gcc_assert (expr->expr_type == EXPR_VARIABLE); if (expr->ts.type == BT_CLASS) @@ -6289,11 +6530,33 @@ gfc_trans_deallocate (gfc_code *code) se.descriptor_only = 1; gfc_conv_expr (&se, expr); - if (expr->rank || gfc_is_coarray (expr)) + if (flag_coarray == GFC_FCOARRAY_LIB + || flag_coarray == GFC_FCOARRAY_SINGLE) + { + bool comp_ref; + symbol_attribute caf_attr = gfc_caf_attr (expr, false, &comp_ref); + if (caf_attr.codimension) + { + is_coarray = true; + is_coarray_array = caf_attr.dimension || !comp_ref + || caf_attr.coarray_comp; + + if (flag_coarray == GFC_FCOARRAY_LIB) + /* When the expression to deallocate is referencing a + component, then only deallocate it, but do not + deregister. */ + caf_mode = GFC_STRUCTURE_CAF_MODE_IN_COARRAY + | (comp_ref && !caf_attr.coarray_comp + ? GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY : 0); + } + } + + if (expr->rank || is_coarray_array) { gfc_ref *ref; - if (gfc_bt_struct (expr->ts.type) && expr->ts.u.derived->attr.alloc_comp + if (gfc_bt_struct (expr->ts.type) + && expr->ts.u.derived->attr.alloc_comp && !gfc_is_finalizable (expr->ts.u.derived, NULL)) { gfc_ref *last = NULL; @@ -6307,16 +6570,36 @@ gfc_trans_deallocate (gfc_code *code) if (!(last && last->u.c.component->attr.pointer) && !(!last && expr->symtree->n.sym->attr.pointer)) { - tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr, - expr->rank); + if (is_coarray && expr->rank == 0 + && (!last || !last->u.c.component->attr.dimension) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))) + { + /* Add the ref to the data member only, when this is not + a regular array or deallocate_alloc_comp will try to + add another one. */ + tmp = gfc_conv_descriptor_data_get (se.expr); + } + else + tmp = se.expr; + tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, + expr->rank, caf_mode); gfc_add_expr_to_block (&se.pre, tmp); } } if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))) { - tmp = gfc_array_deallocate (se.expr, pstat, errmsg, errlen, - label_finish, expr); + gfc_coarray_deregtype caf_dtype; + + if (is_coarray) + caf_dtype = gfc_caf_is_dealloc_only (caf_mode) + ? GFC_CAF_COARRAY_DEALLOCATE_ONLY + : GFC_CAF_COARRAY_DEREGISTER; + else + caf_dtype = GFC_CAF_COARRAY_NOCOARRAY; + tmp = gfc_deallocate_with_status (se.expr, pstat, errmsg, errlen, + label_finish, false, expr, + caf_dtype); gfc_add_expr_to_block (&se.pre, tmp); } else if (TREE_CODE (se.expr) == COMPONENT_REF @@ -6359,8 +6642,9 @@ gfc_trans_deallocate (gfc_code *code) } else { - tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, false, - al->expr, al->expr->ts); + tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, label_finish, + false, al->expr, + al->expr->ts, is_coarray); gfc_add_expr_to_block (&se.pre, tmp); /* Set to zero after deallocation. */ diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index f9c8e74e11..0a39e26c21 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-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -32,7 +32,6 @@ 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 *); -tree gfc_trans_class_assign (gfc_expr *, gfc_expr *, gfc_exec_op); /* trans-stmt.c */ tree gfc_trans_cycle (gfc_code *); @@ -53,9 +52,11 @@ tree gfc_trans_do (gfc_code *, tree); tree gfc_trans_do_concurrent (gfc_code *); tree gfc_trans_do_while (gfc_code *); tree gfc_trans_select (gfc_code *); +tree gfc_trans_select_type (gfc_code *); tree gfc_trans_sync (gfc_code *, gfc_exec_op); tree gfc_trans_lock_unlock (gfc_code *, gfc_exec_op); tree gfc_trans_event_post_wait (gfc_code *, gfc_exec_op); +tree gfc_trans_fail_image (gfc_code *); tree gfc_trans_forall (gfc_code *); tree gfc_trans_where (gfc_code *); tree gfc_trans_allocate (gfc_code *); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 831c84fe28..fc5e486379 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1,5 +1,5 @@ /* Backend support for Fortran 95 basic types and derived types. - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -62,8 +62,8 @@ tree pfunc_type_node; tree gfc_charlen_type_node; -tree float128_type_node = NULL_TREE; -tree complex_float128_type_node = NULL_TREE; +tree gfc_float128_type_node = NULL_TREE; +tree gfc_complex_float128_type_node = NULL_TREE; bool gfc_real16_is_float128 = false; @@ -234,27 +234,42 @@ gfc_get_int_kind_from_width_isofortranenv (int size) return -1; } -/* Get the kind number corresponding to a real of given storage size, - following the required return values for ISO_FORTRAN_ENV REAL* constants: - -2 is returned if we support a kind of larger size, -1 otherwise. */ + +/* Get the kind number corresponding to a real of a given storage size. + If two real's have the same storage size, then choose the real with + the largest precision. If a kind type is unavailable and a real + exists with wider storage, then return -2; otherwise, return -1. */ + int gfc_get_real_kind_from_width_isofortranenv (int size) { - int i; + int digits, i, kind; size /= 8; + kind = -1; + digits = 0; + /* Look for a kind with matching storage size. */ for (i = 0; gfc_real_kinds[i].kind != 0; i++) if (int_size_in_bytes (gfc_get_real_type (gfc_real_kinds[i].kind)) == size) - return gfc_real_kinds[i].kind; + { + if (gfc_real_kinds[i].digits > digits) + { + digits = gfc_real_kinds[i].digits; + kind = gfc_real_kinds[i].kind; + } + } + + if (kind != -1) + return kind; /* Look for a kind with larger storage size. */ for (i = 0; gfc_real_kinds[i].kind != 0; i++) if (int_size_in_bytes (gfc_get_real_type (gfc_real_kinds[i].kind)) > size) - return -2; + kind = -2; - return -1; + return kind; } @@ -861,7 +876,7 @@ gfc_build_logical_type (gfc_logical_info *info) void gfc_init_types (void) { - char name_buf[18]; + char name_buf[26]; int index; tree type; unsigned n; @@ -901,7 +916,7 @@ gfc_init_types (void) PUSH_TYPE (name_buf, type); if (gfc_real_kinds[index].c_float128) - float128_type_node = type; + gfc_float128_type_node = type; type = gfc_build_complex_type (type); gfc_complex_types[index] = type; @@ -910,7 +925,7 @@ gfc_init_types (void) PUSH_TYPE (name_buf, type); if (gfc_real_kinds[index].c_float128) - complex_float128_type_node = type; + gfc_complex_float128_type_node = type; } for (index = 0; gfc_character_kinds[index].kind != 0; ++index) @@ -961,10 +976,6 @@ gfc_init_types (void) wi::mask (n, UNSIGNED, TYPE_PRECISION (size_type_node))); - boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind); - boolean_true_node = build_int_cst (boolean_type_node, 1); - boolean_false_node = build_int_cst (boolean_type_node, 0); - /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */ gfc_charlen_int_kind = 4; gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind); @@ -1051,10 +1062,10 @@ gfc_get_character_type (int kind, gfc_charlen * cl) return gfc_get_character_type_len (kind, len); } -/* Covert a basic type. This will be an array for character types. */ +/* Convert a basic type. This will be an array for character types. */ tree -gfc_typenode_for_spec (gfc_typespec * spec) +gfc_typenode_for_spec (gfc_typespec * spec, int codim) { tree basetype; @@ -1107,7 +1118,7 @@ gfc_typenode_for_spec (gfc_typespec * spec) case BT_DERIVED: case BT_CLASS: - basetype = gfc_get_derived_type (spec->u.derived); + basetype = gfc_get_derived_type (spec->u.derived, codim); if (spec->type == BT_CLASS) GFC_CLASS_TYPE_P (basetype) = 1; @@ -1311,7 +1322,7 @@ gfc_is_nodesc_array (gfc_symbol * sym) static tree gfc_build_array_type (tree type, gfc_array_spec * as, enum gfc_array_kind akind, bool restricted, - bool contiguous) + bool contiguous, int codim) { tree lbound[GFC_MAX_DIMENSIONS]; tree ubound[GFC_MAX_DIMENSIONS]; @@ -1319,10 +1330,10 @@ gfc_build_array_type (tree type, gfc_array_spec * as, /* Assumed-shape arrays do not have codimension information stored in the descriptor. */ - corank = as->corank; + corank = MAX (as->corank, codim); if (as->type == AS_ASSUMED_SHAPE || (as->type == AS_ASSUMED_RANK && akind == GFC_ARRAY_ALLOCATABLE)) - corank = 0; + corank = codim; if (as->type == AS_ASSUMED_RANK) for (n = 0; n < GFC_MAX_DIMENSIONS; n++) @@ -1360,8 +1371,8 @@ gfc_build_array_type (tree type, gfc_array_spec * as, : GFC_ARRAY_ASSUMED_RANK; return gfc_get_array_type_bounds (type, as->rank == -1 ? GFC_MAX_DIMENSIONS : as->rank, - corank, lbound, - ubound, 0, akind, restricted); + corank, lbound, ubound, 0, akind, + restricted); } /* Returns the struct descriptor_dimension type. */ @@ -1723,8 +1734,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed, /* Return or create the base type for an array descriptor. */ static tree -gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted, - enum gfc_array_kind akind) +gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) { tree fat_type, decl, arraytype, *chain = NULL; char name[16 + 2*GFC_RANK_DIGITS + 1 + 1]; @@ -1786,8 +1796,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted, TREE_NO_WARNING (decl) = 1; } - if (flag_coarray == GFC_FCOARRAY_LIB && codimen - && akind == GFC_ARRAY_ALLOCATABLE) + if (flag_coarray == GFC_FCOARRAY_LIB && codimen) { decl = gfc_add_field_to_struct_1 (fat_type, get_identifier ("token"), @@ -1799,8 +1808,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted, gfc_finish_type (fat_type); TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (fat_type)) = 1; - if (flag_coarray == GFC_FCOARRAY_LIB && codimen - && akind == GFC_ARRAY_ALLOCATABLE) + if (flag_coarray == GFC_FCOARRAY_LIB && codimen) gfc_array_descriptor_base_caf[idx] = fat_type; else gfc_array_descriptor_base[idx] = fat_type; @@ -1821,11 +1829,11 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound, const char *type_name; int n; - base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted, akind); + base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted); fat_type = build_distinct_type_copy (base_type); /* Make sure that nontarget and target array type have the same canonical type (and same stub decl for debug info). */ - base_type = gfc_get_array_descriptor_base (dimen, codimen, false, akind); + base_type = gfc_get_array_descriptor_base (dimen, codimen, false); TYPE_CANONICAL (fat_type) = base_type; TYPE_STUB_DECL (fat_type) = TYPE_STUB_DECL (base_type); @@ -2161,7 +2169,7 @@ gfc_sym_type (gfc_symbol * sym) || !sym->ts.u.cl->backend_decl)))) type = gfc_character1_type_node; else - type = gfc_typenode_for_spec (&sym->ts); + type = gfc_typenode_for_spec (&sym->ts, sym->attr.codimension); if (sym->attr.dummy && !sym->attr.function && !sym->attr.value) byref = 1; @@ -2199,7 +2207,7 @@ gfc_sym_type (gfc_symbol * sym) else if (sym->attr.allocatable) akind = GFC_ARRAY_ALLOCATABLE; type = gfc_build_array_type (type, sym->as, akind, restricted, - sym->attr.contiguous); + sym->attr.contiguous, false); } } else @@ -2279,7 +2287,7 @@ gfc_add_field_to_struct (tree context, tree name, tree type, tree **chain) tree decl = gfc_add_field_to_struct_1 (context, name, type, chain); DECL_INITIAL (decl) = 0; - DECL_ALIGN (decl) = 0; + SET_DECL_ALIGN (decl, 0); DECL_USER_ALIGN (decl) = 0; return decl; @@ -2417,7 +2425,7 @@ gfc_get_union_type (gfc_symbol *un) in a parent namespace, this is used. */ tree -gfc_get_derived_type (gfc_symbol * derived) +gfc_get_derived_type (gfc_symbol * derived, int codimen) { tree typenode = NULL, field = NULL, field_type = NULL; tree canonical = NULL_TREE; @@ -2521,7 +2529,11 @@ gfc_get_derived_type (gfc_symbol * derived) non-procedure pointer components have no backend_decl. */ for (c = derived->components; c; c = c->next) { - if (!c->attr.proc_pointer && c->backend_decl == NULL) + bool same_alloc_type = c->attr.allocatable + && derived == c->ts.u.derived; + if (!c->attr.proc_pointer + && !same_alloc_type + && c->backend_decl == NULL) break; else if (c->next == NULL) return derived->backend_decl; @@ -2553,15 +2565,23 @@ gfc_get_derived_type (gfc_symbol * derived) will be built and so we can return the type. */ for (c = derived->components; c; c = c->next) { + bool same_alloc_type = c->attr.allocatable + && derived == c->ts.u.derived; + if (c->ts.type == BT_UNION && c->ts.u.derived->backend_decl == NULL) c->ts.u.derived->backend_decl = gfc_get_union_type (c->ts.u.derived); if (c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS) continue; - if ((!c->attr.pointer && !c->attr.proc_pointer) + if ((!c->attr.pointer && !c->attr.proc_pointer + && !same_alloc_type) || c->ts.u.derived->backend_decl == NULL) - c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived); + { + int local_codim = c->attr.codimension ? c->as->corank: codimen; + c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived, + local_codim); + } if (c->ts.u.derived->attr.is_iso_c) { @@ -2591,6 +2611,8 @@ gfc_get_derived_type (gfc_symbol * derived) types are built as part of gfc_get_union_type. */ for (c = derived->components; c; c = c->next) { + bool same_alloc_type = c->attr.allocatable + && derived == c->ts.u.derived; /* Prevent infinite recursion, when the procedure pointer type is the same as derived, by forcing the procedure pointer component to be built as if the explicit interface does not exist. */ @@ -2618,7 +2640,7 @@ gfc_get_derived_type (gfc_symbol * derived) c->ts.u.cl->backend_decl = build_int_cst (gfc_charlen_type_node, 0); - field_type = gfc_typenode_for_spec (&c->ts); + field_type = gfc_typenode_for_spec (&c->ts, codimen); } /* This returns an array descriptor type. Initialization may be @@ -2638,7 +2660,8 @@ gfc_get_derived_type (gfc_symbol * derived) field_type = gfc_build_array_type (field_type, c->as, akind, !c->attr.target && !c->attr.pointer, - c->attr.contiguous); + c->attr.contiguous, + codimen); } else field_type = gfc_get_nodesc_array_type (field_type, c->as, @@ -2650,7 +2673,7 @@ gfc_get_derived_type (gfc_symbol * derived) && !(unlimited_entity && c == derived->components)) field_type = build_pointer_type (field_type); - if (c->attr.pointer) + if (c->attr.pointer || same_alloc_type) field_type = gfc_nonrestricted_type (field_type); /* vtype fields can point to different types to the base type. */ @@ -2683,6 +2706,19 @@ gfc_get_derived_type (gfc_symbol * derived) gcc_assert (field); if (!c->backend_decl) c->backend_decl = field; + + /* Do not add a caf_token field for classes' data components. */ + if (codimen && !c->attr.dimension && !c->attr.codimension + && (c->attr.allocatable || c->attr.pointer) + && c->caf_token == NULL_TREE && strcmp ("_data", c->name) != 0) + { + char caf_name[GFC_MAX_SYMBOL_LEN]; + snprintf (caf_name, GFC_MAX_SYMBOL_LEN, "_caf_%s", c->name); + c->caf_token = gfc_add_field_to_struct (typenode, + get_identifier (caf_name), + pvoid_type_node, &chain); + TREE_NO_WARNING (c->caf_token) = 1; + } } /* Now lay out the derived type, including the fields. */ @@ -3110,7 +3146,7 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) int rank, dim; bool indirect = false; tree etype, ptype, field, t, base_decl; - tree data_off, dim_off, dim_size, elem_size; + tree data_off, dim_off, dtype_off, dim_size, elem_size; tree lower_suboff, upper_suboff, stride_suboff; if (! GFC_DESCRIPTOR_TYPE_P (type)) @@ -3159,7 +3195,7 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) base_decl = make_node (DEBUG_EXPR_DECL); DECL_ARTIFICIAL (base_decl) = 1; TREE_TYPE (base_decl) = indirect ? build_pointer_type (ptype) : ptype; - DECL_MODE (base_decl) = TYPE_MODE (TREE_TYPE (base_decl)); + SET_DECL_MODE (base_decl, TYPE_MODE (TREE_TYPE (base_decl))); GFC_TYPE_ARRAY_BASE_DECL (type, indirect) = base_decl; } info->base_decl = base_decl; @@ -3174,6 +3210,7 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) data_off = byte_position (field); field = DECL_CHAIN (field); field = DECL_CHAIN (field); + dtype_off = byte_position (field); field = DECL_CHAIN (field); dim_off = byte_position (field); dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (field))); @@ -3196,6 +3233,24 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT) info->associated = build2 (NE_EXPR, boolean_type_node, info->data_location, null_pointer_node); + if ((GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK + || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT) + && dwarf_version >= 5) + { + rank = 1; + info->ndimensions = 1; + t = base_decl; + if (!integer_zerop (dtype_off)) + t = fold_build_pointer_plus (t, dtype_off); + t = build1 (NOP_EXPR, build_pointer_type (gfc_array_index_type), t); + t = build1 (INDIRECT_REF, gfc_array_index_type, t); + info->rank = build2 (BIT_AND_EXPR, gfc_array_index_type, t, + build_int_cst (gfc_array_index_type, + GFC_DTYPE_RANK_MASK)); + t = build0 (PLACEHOLDER_EXPR, TREE_TYPE (dim_off)); + t = size_binop (MULT_EXPR, t, dim_size); + dim_off = build2 (PLUS_EXPR, TREE_TYPE (dim_off), t, dim_off); + } for (dim = 0; dim < rank; dim++) { @@ -3231,7 +3286,8 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) t = build1 (INDIRECT_REF, gfc_array_index_type, t); t = build2 (MULT_EXPR, gfc_array_index_type, t, elem_size); info->dimen[dim].stride = t; - dim_off = size_binop (PLUS_EXPR, dim_off, dim_size); + if (dim + 1 < rank) + dim_off = size_binop (PLUS_EXPR, dim_off, dim_size); } return true; @@ -3324,4 +3380,121 @@ gfc_get_caf_vector_type (int dim) return vector_types[dim-1]; } + +tree +gfc_get_caf_reference_type () +{ + static tree reference_type = NULL_TREE; + tree c_struct_type, s_struct_type, v_struct_type, union_type, dim_union_type, + a_struct_type, u_union_type, tmp, *chain; + + if (reference_type != NULL_TREE) + return reference_type; + + chain = 0; + c_struct_type = make_node (RECORD_TYPE); + tmp = gfc_add_field_to_struct_1 (c_struct_type, + get_identifier ("offset"), + gfc_array_index_type, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (c_struct_type, + get_identifier ("caf_token_offset"), + gfc_array_index_type, &chain); + TREE_NO_WARNING (tmp) = 1; + gfc_finish_type (c_struct_type); + + chain = 0; + s_struct_type = make_node (RECORD_TYPE); + tmp = gfc_add_field_to_struct_1 (s_struct_type, + get_identifier ("start"), + gfc_array_index_type, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (s_struct_type, + get_identifier ("end"), + gfc_array_index_type, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (s_struct_type, + get_identifier ("stride"), + gfc_array_index_type, &chain); + TREE_NO_WARNING (tmp) = 1; + gfc_finish_type (s_struct_type); + + chain = 0; + v_struct_type = make_node (RECORD_TYPE); + tmp = gfc_add_field_to_struct_1 (v_struct_type, + get_identifier ("vector"), + pvoid_type_node, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (v_struct_type, + get_identifier ("nvec"), + size_type_node, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (v_struct_type, + get_identifier ("kind"), + integer_type_node, &chain); + TREE_NO_WARNING (tmp) = 1; + gfc_finish_type (v_struct_type); + + chain = 0; + union_type = make_node (UNION_TYPE); + tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("s"), + s_struct_type, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("v"), + v_struct_type, &chain); + TREE_NO_WARNING (tmp) = 1; + gfc_finish_type (union_type); + + tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, + gfc_rank_cst[GFC_MAX_DIMENSIONS - 1]); + dim_union_type = build_array_type (union_type, tmp); + + chain = 0; + a_struct_type = make_node (RECORD_TYPE); + tmp = gfc_add_field_to_struct_1 (a_struct_type, get_identifier ("mode"), + build_array_type (unsigned_char_type_node, + build_range_type (gfc_array_index_type, + gfc_index_zero_node, + gfc_rank_cst[GFC_MAX_DIMENSIONS - 1])), + &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (a_struct_type, + get_identifier ("static_array_type"), + integer_type_node, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (a_struct_type, get_identifier ("dim"), + dim_union_type, &chain); + TREE_NO_WARNING (tmp) = 1; + gfc_finish_type (a_struct_type); + + chain = 0; + u_union_type = make_node (UNION_TYPE); + tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("c"), + c_struct_type, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("a"), + a_struct_type, &chain); + TREE_NO_WARNING (tmp) = 1; + gfc_finish_type (u_union_type); + + chain = 0; + reference_type = make_node (RECORD_TYPE); + tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("next"), + build_pointer_type (reference_type), &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("type"), + integer_type_node, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("item_size"), + size_type_node, &chain); + TREE_NO_WARNING (tmp) = 1; + tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("u"), + u_union_type, &chain); + TREE_NO_WARNING (tmp) = 1; + gfc_finish_type (reference_type); + TYPE_NAME (reference_type) = get_identifier ("caf_reference_t"); + + return reference_type; +} + #include "gt-fortran-trans-types.h" diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 95d98e9359..2974e45130 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-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -30,8 +30,8 @@ extern GTY(()) tree ppvoid_type_node; extern GTY(()) tree pvoid_type_node; extern GTY(()) tree prvoid_type_node; extern GTY(()) tree pchar_type_node; -extern GTY(()) tree float128_type_node; -extern GTY(()) tree complex_float128_type_node; +extern GTY(()) tree gfc_float128_type_node; +extern GTY(()) tree gfc_complex_float128_type_node; /* This is the type used to hold the lengths of character variables. It must be the same as the corresponding definition in gfortran.h. */ @@ -70,7 +70,7 @@ tree gfc_get_character_type_len (int, tree); tree gfc_get_character_type_len_for_eltype (tree, tree); tree gfc_sym_type (gfc_symbol *); -tree gfc_typenode_for_spec (gfc_typespec *); +tree gfc_typenode_for_spec (gfc_typespec *, int c = 0); int gfc_copy_dt_decls_ifequal (gfc_symbol *, gfc_symbol *, bool); tree gfc_get_function_type (gfc_symbol *); @@ -102,5 +102,6 @@ tree gfc_get_dtype (tree); tree gfc_get_ppc_type (gfc_component *); tree gfc_get_caf_vector_type (int dim); +tree gfc_get_caf_reference_type (); #endif diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index c6688d351a..2323e0abe3 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1,5 +1,5 @@ /* Code translation -- generate GCC trees from gfc_code. - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -151,11 +151,11 @@ gfc_add_modify_loc (location_t loc, stmtblock_t * pblock, tree lhs, tree rhs) tree t1, t2; t1 = TREE_TYPE (rhs); t2 = TREE_TYPE (lhs); - /* Make sure that the types of the rhs and the lhs are the same + /* Make sure that the types of the rhs and the lhs are compatible for scalar assignments. We should probably have something similar for aggregates, but right now removing that check just breaks everything. */ - gcc_checking_assert (t1 == t2 + gcc_checking_assert (TYPE_MAIN_VARIANT (t1) == TYPE_MAIN_VARIANT (t2) || AGGREGATE_TYPE_P (TREE_TYPE (lhs))); tmp = fold_build2_loc (loc, MODIFY_EXPR, void_type_node, lhs, @@ -335,7 +335,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) references. */ if (type && TREE_CODE (type) == ARRAY_TYPE && TYPE_MAXVAL (TYPE_DOMAIN (type)) != NULL_TREE - && (TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == VAR_DECL + && (VAR_P (TYPE_MAXVAL (TYPE_DOMAIN (type))) || TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == INDIRECT_REF) && decl && (TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == INDIRECT_REF @@ -356,9 +356,8 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) subreference, use the span that is stored with the backend decl and reference the element with pointer arithmetic. */ if ((decl && (TREE_CODE (decl) == FIELD_DECL - || TREE_CODE (decl) == VAR_DECL - || TREE_CODE (decl) == PARM_DECL - || TREE_CODE (decl) == FUNCTION_DECL) + || VAR_OR_FUNCTION_DECL_P (decl) + || TREE_CODE (decl) == PARM_DECL) && ((GFC_DECL_SUBREF_ARRAY_P (decl) && !integer_zerop (GFC_DECL_SPAN (decl))) || GFC_DECL_CLASS (decl) @@ -672,9 +671,6 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, gfc_start_block (&on_error); if (status != NULL_TREE) { - gfc_add_expr_to_block (&on_error, - build_predict_expr (PRED_FORTRAN_FAIL_ALLOC, - NOT_TAKEN)); tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, status, build_int_cst (status_type, LIBERROR_ALLOCATION)); gfc_add_expr_to_block (&on_error, tmp); @@ -693,7 +689,8 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, boolean_type_node, pointer, build_int_cst (prvoid_type_node, 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - error_cond, gfc_finish_block (&on_error), + gfc_unlikely (error_cond, PRED_FORTRAN_FAIL_ALLOC), + gfc_finish_block (&on_error), build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); @@ -712,10 +709,10 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, newmem = _caf_register (size, regtype, token, &stat, errmsg, errlen); return newmem; } */ -static void -gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, - tree token, tree status, tree errmsg, tree errlen, - bool lock_var, bool event_var) +void +gfc_allocate_using_caf_lib (stmtblock_t * block, tree pointer, tree size, + tree token, tree status, tree errmsg, tree errlen, + gfc_coarray_regtype alloc_type) { tree tmp, pstat; @@ -736,19 +733,13 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, size = fold_convert (size_type_node, size); tmp = build_call_expr_loc (input_location, - gfor_fndecl_caf_register, 6, + gfor_fndecl_caf_register, 7, fold_build2_loc (input_location, - MAX_EXPR, size_type_node, size, - build_int_cst (size_type_node, 1)), - build_int_cst (integer_type_node, - lock_var ? GFC_CAF_LOCK_ALLOC - : event_var ? GFC_CAF_EVENT_ALLOC - : GFC_CAF_COARRAY_ALLOC), - token, pstat, errmsg, errlen); - - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - TREE_TYPE (pointer), pointer, - fold_convert ( TREE_TYPE (pointer), tmp)); + MAX_EXPR, size_type_node, size, size_one_node), + build_int_cst (integer_type_node, alloc_type), + token, gfc_build_addr_expr (pvoid_type_node, pointer), + pstat, errmsg, errlen); + gfc_add_expr_to_block (block, tmp); /* It guarantees memory consistency within the same segment */ @@ -784,49 +775,93 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, expr must be set to the original expression being allocated for its locus and variable name in case a runtime error has to be printed. */ void -gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, - tree status, tree errmsg, tree errlen, tree label_finish, - gfc_expr* expr) +gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, + tree token, tree status, tree errmsg, tree errlen, + tree label_finish, gfc_expr* expr, int corank) { stmtblock_t alloc_block; tree tmp, null_mem, alloc, error; tree type = TREE_TYPE (mem); + symbol_attribute caf_attr; + bool need_assign = false, refs_comp = false; + gfc_coarray_regtype caf_alloc_type = GFC_CAF_COARRAY_ALLOC; size = fold_convert (size_type_node, size); null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, boolean_type_node, mem, build_int_cst (type, 0)), - PRED_FORTRAN_FAIL_ALLOC); + PRED_FORTRAN_REALLOC); /* If mem is NULL, we call gfc_allocate_using_malloc or gfc_allocate_using_lib. */ gfc_start_block (&alloc_block); + if (flag_coarray == GFC_FCOARRAY_LIB) + caf_attr = gfc_caf_attr (expr, true, &refs_comp); + if (flag_coarray == GFC_FCOARRAY_LIB - && gfc_expr_attr (expr).codimension) + && (corank > 0 || caf_attr.codimension)) { - tree cond; - bool lock_var = expr->ts.type == BT_DERIVED - && expr->ts.u.derived->from_intmod - == INTMOD_ISO_FORTRAN_ENV - && expr->ts.u.derived->intmod_sym_id - == ISOFORTRAN_LOCK_TYPE; - bool event_var = expr->ts.type == BT_DERIVED - && expr->ts.u.derived->from_intmod - == INTMOD_ISO_FORTRAN_ENV - && expr->ts.u.derived->intmod_sym_id - == ISOFORTRAN_EVENT_TYPE; + tree cond, sub_caf_tree; + gfc_se se; + bool compute_special_caf_types_size = false; + + if (expr->ts.type == BT_DERIVED + && expr->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV + && expr->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE) + { + compute_special_caf_types_size = true; + caf_alloc_type = GFC_CAF_LOCK_ALLOC; + } + else if (expr->ts.type == BT_DERIVED + && expr->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV + && expr->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE) + { + compute_special_caf_types_size = true; + caf_alloc_type = GFC_CAF_EVENT_ALLOC; + } + else if (!caf_attr.coarray_comp && refs_comp) + /* Only allocatable components in a derived type coarray can be + allocate only. */ + caf_alloc_type = GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY; + + gfc_init_se (&se, NULL); + sub_caf_tree = gfc_get_ultimate_alloc_ptr_comps_caf_token (&se, expr); + if (sub_caf_tree == NULL_TREE) + sub_caf_tree = token; + + /* When mem is an array ref, then strip the .data-ref. */ + if (TREE_CODE (mem) == COMPONENT_REF + && !(GFC_ARRAY_TYPE_P (TREE_TYPE (mem)))) + tmp = TREE_OPERAND (mem, 0); + else + tmp = mem; + + if (!(GFC_ARRAY_TYPE_P (TREE_TYPE (tmp)) + && TYPE_LANG_SPECIFIC (TREE_TYPE (tmp))->corank == 0) + && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + { + symbol_attribute attr; + + gfc_clear_attr (&attr); + tmp = gfc_conv_scalar_to_descriptor (&se, mem, attr); + need_assign = true; + } + gfc_add_block_to_block (&alloc_block, &se.pre); + /* In the front end, we represent the lock variable as pointer. However, the FE only passes the pointer around and leaves the actual representation to the library. Hence, we have to convert back to the number of elements. */ - if (lock_var || event_var) + if (compute_special_caf_types_size) size = fold_build2_loc (input_location, TRUNC_DIV_EXPR, size_type_node, size, TYPE_SIZE_UNIT (ptr_type_node)); - gfc_allocate_using_lib (&alloc_block, mem, size, token, status, - errmsg, errlen, lock_var, event_var); - + gfc_allocate_using_caf_lib (&alloc_block, tmp, size, sub_caf_tree, + status, errmsg, errlen, caf_alloc_type); + if (need_assign) + gfc_add_modify (&alloc_block, mem, fold_convert (TREE_TYPE (mem), + gfc_conv_descriptor_data_get (tmp))); if (status != NULL_TREE) { TREE_USED (label_finish) = 1; @@ -1150,11 +1185,11 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) final_expr = gfc_copy_expr (expr); gfc_add_vptr_component (final_expr); - gfc_add_component_ref (final_expr, "_final"); + gfc_add_final_component (final_expr); elem_size = gfc_copy_expr (expr); gfc_add_vptr_component (elem_size); - gfc_add_component_ref (elem_size, "_size"); + gfc_add_size_component (elem_size); } gcc_assert (final_expr->expr_type == EXPR_VARIABLE); @@ -1236,24 +1271,67 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) expression being deallocated for its locus and variable name. For coarrays, "pointer" must be the array descriptor and not its - "data" component. */ + "data" component. + + COARRAY_DEALLOC_MODE gives the mode unregister coarrays. Available modes are + the ones of GFC_CAF_DEREGTYPE, -1 when the mode for deregistration is to be + analyzed and set by this routine, and -2 to indicate that a non-coarray is to + be deallocated. */ tree gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, tree errlen, tree label_finish, - bool can_fail, gfc_expr* expr, bool coarray) + bool can_fail, gfc_expr* expr, + int coarray_dealloc_mode, tree add_when_allocated, + tree caf_token) { stmtblock_t null, non_null; tree cond, tmp, error; tree status_type = NULL_TREE; - tree caf_decl = NULL_TREE; + tree token = NULL_TREE; + gfc_coarray_deregtype caf_dereg_type = GFC_CAF_COARRAY_DEREGISTER; - if (coarray) + if (coarray_dealloc_mode >= GFC_CAF_COARRAY_ANALYZE) { - gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer))); - caf_decl = pointer; - pointer = gfc_conv_descriptor_data_get (caf_decl); - STRIP_NOPS (pointer); + if (flag_coarray == GFC_FCOARRAY_LIB) + { + if (caf_token) + token = caf_token; + else + { + tree caf_type, caf_decl = pointer; + pointer = gfc_conv_descriptor_data_get (caf_decl); + caf_type = TREE_TYPE (caf_decl); + STRIP_NOPS (pointer); + if (GFC_DESCRIPTOR_TYPE_P (caf_type)) + token = gfc_conv_descriptor_token (caf_decl); + else if (DECL_LANG_SPECIFIC (caf_decl) + && GFC_DECL_TOKEN (caf_decl) != NULL_TREE) + token = GFC_DECL_TOKEN (caf_decl); + else + { + gcc_assert (GFC_ARRAY_TYPE_P (caf_type) + && GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) + != NULL_TREE); + token = GFC_TYPE_ARRAY_CAF_TOKEN (caf_type); + } + } + + if (coarray_dealloc_mode == GFC_CAF_COARRAY_ANALYZE) + { + bool comp_ref; + if (expr && !gfc_caf_attr (expr, false, &comp_ref).coarray_comp + && comp_ref) + caf_dereg_type = GFC_CAF_COARRAY_DEALLOCATE_ONLY; + // else do a deregister as set by default. + } + else + caf_dereg_type = (enum gfc_coarray_deregtype) coarray_dealloc_mode; + } + else if (flag_coarray == GFC_FCOARRAY_SINGLE) + pointer = gfc_conv_descriptor_data_get (pointer); } + else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer))) + pointer = gfc_conv_descriptor_data_get (pointer); cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer, build_int_cst (TREE_TYPE (pointer), 0)); @@ -1296,13 +1374,18 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, /* When POINTER is not NULL, we free it. */ gfc_start_block (&non_null); + if (add_when_allocated) + gfc_add_expr_to_block (&non_null, add_when_allocated); gfc_add_finalizer_call (&non_null, expr); - if (!coarray || flag_coarray != GFC_FCOARRAY_LIB) + if (coarray_dealloc_mode == GFC_CAF_COARRAY_NOCOARRAY + || flag_coarray != GFC_FCOARRAY_LIB) { tmp = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_FREE), 1, fold_convert (pvoid_type_node, pointer)); gfc_add_expr_to_block (&non_null, tmp); + gfc_add_modify (&non_null, pointer, build_int_cst (TREE_TYPE (pointer), + 0)); if (status != NULL_TREE && !integer_zerop (status)) { @@ -1325,8 +1408,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, } else { - tree caf_type, token, cond2; - tree pstat = null_pointer_node; + tree cond2, pstat = null_pointer_node; if (errmsg == NULL_TREE) { @@ -1341,31 +1423,19 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, errmsg = gfc_build_addr_expr (NULL_TREE, errmsg); } - caf_type = TREE_TYPE (caf_decl); - if (status != NULL_TREE && !integer_zerop (status)) { gcc_assert (status_type == integer_type_node); pstat = status; } - if (GFC_DESCRIPTOR_TYPE_P (caf_type) - && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE) - token = gfc_conv_descriptor_token (caf_decl); - else if (DECL_LANG_SPECIFIC (caf_decl) - && GFC_DECL_TOKEN (caf_decl) != NULL_TREE) - token = GFC_DECL_TOKEN (caf_decl); - else - { - gcc_assert (GFC_ARRAY_TYPE_P (caf_type) - && GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) != NULL_TREE); - token = GFC_TYPE_ARRAY_CAF_TOKEN (caf_type); - } - token = gfc_build_addr_expr (NULL_TREE, token); + gcc_assert (caf_dereg_type > GFC_CAF_COARRAY_ANALYZE); tmp = build_call_expr_loc (input_location, - gfor_fndecl_caf_deregister, 4, - token, pstat, errmsg, errlen); + gfor_fndecl_caf_deregister, 5, + token, build_int_cst (integer_type_node, + caf_dereg_type), + pstat, errmsg, errlen); gfc_add_expr_to_block (&non_null, tmp); /* It guarantees memory consistency within the same segment */ @@ -1379,16 +1449,23 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, if (status != NULL_TREE) { tree stat = build_fold_indirect_ref_loc (input_location, status); + tree nullify = fold_build2_loc (input_location, MODIFY_EXPR, + void_type_node, pointer, + build_int_cst (TREE_TYPE (pointer), + 0)); TREE_USED (label_finish) = 1; tmp = build1_v (GOTO_EXPR, label_finish); cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat, build_zero_cst (TREE_TYPE (stat))); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, - gfc_unlikely (cond2, PRED_FORTRAN_FAIL_ALLOC), - tmp, build_empty_stmt (input_location)); + gfc_unlikely (cond2, PRED_FORTRAN_REALLOC), + tmp, nullify); gfc_add_expr_to_block (&non_null, tmp); } + else + gfc_add_modify (&non_null, pointer, build_int_cst (TREE_TYPE (pointer), + 0)); } return fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, @@ -1402,12 +1479,18 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, subcomponents are being deallocated. */ tree -gfc_deallocate_scalar_with_status (tree pointer, tree status, bool can_fail, - gfc_expr* expr, gfc_typespec ts) +gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, + bool can_fail, gfc_expr* expr, + gfc_typespec ts, bool coarray) { stmtblock_t null, non_null; tree cond, tmp, error; - bool finalizable; + bool finalizable, comp_ref; + gfc_coarray_deregtype caf_dereg_type = GFC_CAF_COARRAY_DEREGISTER; + + if (coarray && expr && !gfc_caf_attr (expr, false, &comp_ref).coarray_comp + && comp_ref) + caf_dereg_type = GFC_CAF_COARRAY_DEALLOCATE_ONLY; cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer, build_int_cst (TREE_TYPE (pointer), 0)); @@ -1445,7 +1528,6 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, bool can_fail, error = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2, tmp, error); } - gfc_add_expr_to_block (&null, error); /* When POINTER is not NULL, we free it. */ @@ -1455,31 +1537,90 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, bool can_fail, finalizable = gfc_add_finalizer_call (&non_null, expr); if (!finalizable && ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp) { - tmp = build_fold_indirect_ref_loc (input_location, pointer); - tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0); + int caf_mode = coarray + ? ((caf_dereg_type == GFC_CAF_COARRAY_DEALLOCATE_ONLY + ? GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY : 0) + | GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY + | GFC_STRUCTURE_CAF_MODE_IN_COARRAY) + : 0; + if (coarray && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer))) + tmp = gfc_conv_descriptor_data_get (pointer); + else + tmp = build_fold_indirect_ref_loc (input_location, pointer); + tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0, caf_mode); gfc_add_expr_to_block (&non_null, tmp); } - tmp = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_FREE), 1, - fold_convert (pvoid_type_node, pointer)); - gfc_add_expr_to_block (&non_null, tmp); + if (!coarray || flag_coarray == GFC_FCOARRAY_SINGLE) + { + tmp = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_FREE), 1, + fold_convert (pvoid_type_node, pointer)); + gfc_add_expr_to_block (&non_null, tmp); - if (status != NULL_TREE && !integer_zerop (status)) + if (status != NULL_TREE && !integer_zerop (status)) + { + /* We set STATUS to zero if it is present. */ + tree status_type = TREE_TYPE (TREE_TYPE (status)); + tree cond2; + + cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + status, + build_int_cst (TREE_TYPE (status), 0)); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, + fold_build1_loc (input_location, INDIRECT_REF, + status_type, status), + build_int_cst (status_type, 0)); + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, + cond2, tmp, build_empty_stmt (input_location)); + gfc_add_expr_to_block (&non_null, tmp); + } + } + else { - /* We set STATUS to zero if it is present. */ - tree status_type = TREE_TYPE (TREE_TYPE (status)); - tree cond2; + tree token; + tree pstat = null_pointer_node; + gfc_se se; - cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - status, build_int_cst (TREE_TYPE (status), 0)); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, - fold_build1_loc (input_location, INDIRECT_REF, - status_type, status), - build_int_cst (status_type, 0)); - tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2, - tmp, build_empty_stmt (input_location)); + gfc_init_se (&se, NULL); + token = gfc_get_ultimate_alloc_ptr_comps_caf_token (&se, expr); + gcc_assert (token != NULL_TREE); + + if (status != NULL_TREE && !integer_zerop (status)) + { + gcc_assert (TREE_TYPE (TREE_TYPE (status)) == integer_type_node); + pstat = status; + } + + tmp = build_call_expr_loc (input_location, + gfor_fndecl_caf_deregister, 5, + token, build_int_cst (integer_type_node, + caf_dereg_type), + pstat, null_pointer_node, integer_zero_node); + gfc_add_expr_to_block (&non_null, tmp); + + /* It guarantees memory consistency within the same segment. */ + tmp = gfc_build_string_const (strlen ("memory")+1, "memory"); + tmp = build5_loc (input_location, ASM_EXPR, void_type_node, + gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE, + tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE); + ASM_VOLATILE_P (tmp) = 1; gfc_add_expr_to_block (&non_null, tmp); + + if (status != NULL_TREE) + { + tree stat = build_fold_indirect_ref_loc (input_location, status); + tree cond2; + + TREE_USED (label_finish) = 1; + tmp = build1_v (GOTO_EXPR, label_finish); + cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + stat, build_zero_cst (TREE_TYPE (stat))); + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, + gfc_unlikely (cond2, PRED_FORTRAN_REALLOC), + tmp, build_empty_stmt (input_location)); + gfc_add_expr_to_block (&non_null, tmp); + } } return fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, @@ -1487,7 +1628,6 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, bool can_fail, gfc_finish_block (&non_null)); } - /* Reallocate MEM so it has SIZE bytes of data. This behaves like the following pseudo-code: @@ -1674,10 +1814,7 @@ trans_code (gfc_code * code, tree cond) break; case EXEC_ASSIGN: - if (code->expr1->ts.type == BT_CLASS) - res = gfc_trans_class_assign (code->expr1, code->expr2, code->op); - else - res = gfc_trans_assign (code); + res = gfc_trans_assign (code); break; case EXEC_LABEL_ASSIGN: @@ -1685,16 +1822,7 @@ trans_code (gfc_code * code, tree cond) break; case EXEC_POINTER_ASSIGN: - if (code->expr1->ts.type == BT_CLASS) - res = gfc_trans_class_assign (code->expr1, code->expr2, code->op); - else if (UNLIMITED_POLY (code->expr2) - && code->expr1->ts.type == BT_DERIVED - && (code->expr1->ts.u.derived->attr.sequence - || code->expr1->ts.u.derived->attr.is_bind_c)) - /* F2003: C717 */ - res = gfc_trans_class_assign (code->expr1, code->expr2, code->op); - else - res = gfc_trans_pointer_assign (code); + res = gfc_trans_pointer_assign (code); break; case EXEC_INIT_ASSIGN: @@ -1802,10 +1930,7 @@ trans_code (gfc_code * code, tree cond) break; case EXEC_SELECT_TYPE: - /* Do nothing. SELECT TYPE statements should be transformed into - an ordinary SELECT CASE at resolution stage. - TODO: Add an error message here once this is done. */ - res = NULL_TREE; + res = gfc_trans_select_type (code); break; case EXEC_FLUSH: @@ -1828,6 +1953,10 @@ trans_code (gfc_code * code, tree cond) res = gfc_trans_event_post_wait (code, code->op); break; + case EXEC_FAIL_IMAGE: + res = gfc_trans_fail_image (code); + break; + case EXEC_FORALL: res = gfc_trans_forall (code); break; @@ -1916,6 +2045,12 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -1924,6 +2059,8 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_TEAMS: diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 512615ab1e..d02f3470ee 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -1,5 +1,5 @@ /* Header for code translation functions - Copyright (C) 2002-2016 Free Software Foundation, Inc. + Copyright (C) 2002-2017 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -107,7 +107,7 @@ gfc_se; /* Denotes different types of coarray. Please keep in sync with libgfortran/caf/libcaf.h. */ -enum gfc_coarray_type +enum gfc_coarray_regtype { GFC_CAF_COARRAY_STATIC, GFC_CAF_COARRAY_ALLOC, @@ -115,7 +115,52 @@ enum gfc_coarray_type GFC_CAF_LOCK_ALLOC, GFC_CAF_CRITICAL, GFC_CAF_EVENT_STATIC, - GFC_CAF_EVENT_ALLOC + GFC_CAF_EVENT_ALLOC, + GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY, + GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY +}; + + +/* Describes the action to take on _caf_deregister. Keep in sync with + gcc/fortran/trans.h. The negative values are not valid for the library and + are used by the drivers for building the correct call. */ +enum gfc_coarray_deregtype { + /* This is no coarray, i.e. build a call to a free (). */ + GFC_CAF_COARRAY_NOCOARRAY = -2, + /* The driver is to analyze which _caf_deregister ()-call to generate. */ + GFC_CAF_COARRAY_ANALYZE = -1, + GFC_CAF_COARRAY_DEREGISTER = 0, + GFC_CAF_COARRAY_DEALLOCATE_ONLY +}; + + +/* Specify the type of ref handed to the caf communication functions. + Please keep in sync with libgfortran/caf/libcaf.h. */ +enum gfc_caf_ref_type_t { + GFC_CAF_REF_COMPONENT, + GFC_CAF_REF_ARRAY, + GFC_CAF_REF_STATIC_ARRAY +}; + + +/* Give the reference type of an array ref. + Please keep in sync with libgfortran/caf/libcaf.h. */ +enum gfc_caf_array_ref_t { + GFC_CAF_ARR_REF_NONE = 0, + GFC_CAF_ARR_REF_VECTOR, + GFC_CAF_ARR_REF_FULL, + GFC_CAF_ARR_REF_RANGE, + GFC_CAF_ARR_REF_SINGLE, + GFC_CAF_ARR_REF_OPEN_END, + GFC_CAF_ARR_REF_OPEN_START +}; + + +/* trans-array (structure_alloc_comps) caf_mode bits. */ +enum gfc_structure_caf_mode_t { + GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY = 1 << 0, + GFC_STRUCTURE_CAF_MODE_IN_COARRAY = 1 << 1, + GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY = 1 << 2 }; @@ -382,6 +427,7 @@ 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); +tree gfc_vptr_deallocate_get (tree); void gfc_reset_vptr (stmtblock_t *, gfc_expr *); void gfc_reset_len (stmtblock_t *, gfc_expr *); tree gfc_get_vptr_from_expr (tree); @@ -441,14 +487,14 @@ void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr); void gfc_conv_expr_reference (gfc_se * se, gfc_expr *); void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree); -tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute); - /* trans-expr.c */ +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 (tree *, tree *, tree, tree, gfc_expr *); +void gfc_get_caf_token_offset (gfc_se*, tree *, tree *, tree, tree, gfc_expr *); tree gfc_caf_get_image_index (stmtblock_t *, gfc_expr *, tree); /* Find the decl containing the auxiliary variables for assigned variables. */ @@ -484,7 +530,8 @@ int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool); /* Generate code for a scalar assignment. */ -tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool); +tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool, + bool c = false); /* Translate COMMON blocks. */ void gfc_trans_common (gfc_namespace *); @@ -659,26 +706,33 @@ tree gfc_call_malloc (stmtblock_t *, tree, tree); /* Build a memcpy call. */ tree gfc_build_memcpy_call (tree, tree, tree); +/* Register memory with the coarray library. */ +void gfc_allocate_using_caf_lib (stmtblock_t *, tree, tree, tree, tree, tree, + tree, gfc_coarray_regtype); + /* Allocate memory for allocatable variables, with optional status variable. */ void gfc_allocate_allocatable (stmtblock_t*, tree, tree, tree, tree, - tree, tree, tree, gfc_expr*); + tree, tree, tree, gfc_expr*, int); /* Allocate memory, with optional status variable. */ void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree); /* Generate code to deallocate an array. */ tree gfc_deallocate_with_status (tree, tree, tree, tree, tree, bool, - gfc_expr *, bool); -tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespec); + gfc_expr *, int, tree a = NULL_TREE, + tree c = NULL_TREE); +tree gfc_deallocate_scalar_with_status (tree, tree, tree, bool, gfc_expr*, + gfc_typespec, bool c = false); /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); /* Assign a derived type constructor to a variable. */ -tree gfc_trans_structure_assign (tree, gfc_expr *, bool); +tree gfc_trans_structure_assign (tree, gfc_expr *, bool, bool c = false); /* Generate code for an assignment, includes scalarization. */ -tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool); +tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool, bool p = false, + bool a = true); /* Generate code for a pointer assignment. */ tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *); @@ -719,6 +773,7 @@ tree gfc_omp_clause_assign_op (tree, tree, tree); tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree); tree gfc_omp_clause_dtor (tree, tree); void gfc_omp_finish_clause (tree, gimple_seq *); +bool gfc_omp_scalar_p (tree); bool gfc_omp_disregard_value_expr (tree, bool); bool gfc_omp_private_debug_clause (tree, bool); bool gfc_omp_private_outer_ref (tree); @@ -729,7 +784,6 @@ void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); extern GTY(()) tree gfor_fndecl_pause_numeric; extern GTY(()) tree gfor_fndecl_pause_string; extern GTY(()) tree gfor_fndecl_stop_numeric; -extern GTY(()) tree gfor_fndecl_stop_numeric_f08; extern GTY(()) tree gfor_fndecl_stop_string; extern GTY(()) tree gfor_fndecl_error_stop_numeric; extern GTY(()) tree gfor_fndecl_error_stop_string; @@ -760,6 +814,9 @@ extern GTY(()) tree gfor_fndecl_caf_deregister; extern GTY(()) tree gfor_fndecl_caf_get; extern GTY(()) tree gfor_fndecl_caf_send; extern GTY(()) tree gfor_fndecl_caf_sendget; +extern GTY(()) tree gfor_fndecl_caf_get_by_ref; +extern GTY(()) tree gfor_fndecl_caf_send_by_ref; +extern GTY(()) tree gfor_fndecl_caf_sendget_by_ref; extern GTY(()) tree gfor_fndecl_caf_sync_all; extern GTY(()) tree gfor_fndecl_caf_sync_memory; extern GTY(()) tree gfor_fndecl_caf_sync_images; @@ -776,12 +833,16 @@ extern GTY(()) tree gfor_fndecl_caf_unlock; extern GTY(()) tree gfor_fndecl_caf_event_post; extern GTY(()) tree gfor_fndecl_caf_event_wait; extern GTY(()) tree gfor_fndecl_caf_event_query; +extern GTY(()) tree gfor_fndecl_caf_fail_image; +extern GTY(()) tree gfor_fndecl_caf_failed_images; +extern GTY(()) tree gfor_fndecl_caf_image_status; +extern GTY(()) tree gfor_fndecl_caf_stopped_images; extern GTY(()) tree gfor_fndecl_co_broadcast; extern GTY(()) tree gfor_fndecl_co_max; extern GTY(()) tree gfor_fndecl_co_min; extern GTY(()) tree gfor_fndecl_co_reduce; 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. */ diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def index 8780b761da..1f8a5a1277 100644 --- a/gcc/fortran/types.def +++ b/gcc/fortran/types.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2001-2016 Free Software Foundation, Inc. +/* Copyright (C) 2001-2017 Free Software Foundation, Inc. This file is part of GCC. |